home *** CD-ROM | disk | FTP | other *** search
/ BBS Toolkit / BBS Toolkit.iso / rbbs_pc / mpl17ds.zip / RBBSSUB3.BAS < prev    next >
BASIC Source File  |  1989-06-12  |  123KB  |  3,303 lines
  1. ' $linesize:132
  2. ' $title: 'RBBSSUB3.BAS CPC17-1D  Copyright 1986 - 89 by D. Thomas Mack'
  3. '  Copyright 1987 by D. Thomas Mack, all rights reserved.
  4. '  Name ...............: RBBSSUB3.BAS
  5. '  Written by .........: D. Thomas Mack
  6. '  First Released .....: September 18, 1988
  7. '  Subsequent Releases.: OCTOBER 30 1988
  8. '  Copyright ..........: 1986, 1987, 1988
  9. '  Purpose.............: The Remote Bulletin Board System for the IBM PC,
  10. '                        RBBS-PC.BAS utilizes a lot of common subroutines.
  11. '                        Those that do not require error trapping are
  12. '                        incorporated within RBBSSUB2.BAS, RBBSSUB3.BAS,
  13. '                        RBBSSUB4.BAS and RBBSSUB5.BAS as separately
  14. '                        callable subroutines in order to free up as much
  15. '                        code as possible within the 64K code segment
  16. '                        used by RBBS-PC.BAS.
  17. '  Parameters..........: Most parameters are passed via a COMMON statement.
  18. '
  19. ' Subroutine  Line               Function of Subroutine
  20. '   Name     Number
  21. '  ALLCAPS    58060   Convert a string to all upper case characters
  22. '  AMORPM     41500   Calculate the current time as AM or PM
  23. '  ASKGRAPH   43306   Determine users graphic default
  24. '  BADFILE    20741   Check for system crash attempt with bad device name
  25. '  CALLOPT    58090   Set prompts based on the user's security
  26. '  CARRIER    42000   Test for Carrier present
  27. '  CHECKRATIO 20096   Test upload/download ratio
  28. '  CHECKTIM   58070   Test to insure that users don't exceed their time
  29. '  CHKNEWBUL  58110   Check for new bulletins based on their file creation date
  30. '  CHKTREMAIN 41008   Set up to log off if time exceeded
  31. '  COMMINFO   44000+  Get users baud rate and parity in a string format
  32. '  CTLINES    58160   Count categories a file can be classified into
  33. '  CTNEWFILES 58150   Check for number of files uploaded after a specific date
  34. '  DELAYIT    50500   Wait number of seconds specified before returning
  35. '  DISPCALL   57001   Display callers file
  36. '  DISPLAYTR  41010+  Compute and display time remaining
  37. '  DISUPDIR   58165   Display the shared directory of the FMS mng. sys.
  38. '  FILELOCK   21995   Allow files to be shared among multiple RBBS-PC's
  39. '  FINDFUNC   30600   Handle local keyboard's function & SYSOP's keys
  40. '  FINDLAST   58600   Finds last occurence of a string in a string
  41. '  FINDTIME   58050   Calculate the number of seconds since midnight
  42. '  GRAPHIC    43031   Determines whether graphic version of file exists
  43. '  HASHRBBS   58080   "Hash" to a user's record in the USERS file
  44. '  INITFMS    58160+  Initialize the RBBS-PC's File Management System
  45. '  INITIBM    30000   Open/create NETBIOS semaphore file
  46. '  INSCOMMA   58130   Format commands in the command prompt
  47. '  LIBRARY    21105   Provide support for "library" drives
  48. '  LOADNEW    58140   Find the latest uploads
  49. '  MODEMPUT   52070   Write a modem command string to the modem
  50. '  OPENMSG    30500   Open the messages file as file number 1
  51. '  PAGEUP     33202   Display user info. on local screen for SYSOP
  52. '  READPROF   44000   Read user's profile on return from a "door"
  53. '  SAVEPROF   43070   Save the user's provile when exiting to "doors" or DOS
  54. '  SENDNAME   20295   Send filename via EXEC-PC protocol during autodownload
  55. '  SETOPTS    58100   Set correct prompt line for each subsystem
  56. '  SRTSTRNG   58120   Sort characters in a string
  57. '  TESTUSER   20310   Check if user's software can do auto downloading
  58. '  TIMEREMAIN 41010   Compute time remaining in minutes
  59. '  UPDTUPLOAD 20705   Updates upload directory file
  60. '  WILDFILE   20290   Determines whether string matches a pattern
  61. '  XFERTYPE   21600   Identify the file transfer protocol
  62. '
  63. '  $INCLUDE: 'RBBS-VAR.BAS'
  64. '
  65. ' $SUBTITLE: 'WILDFILE -- Matches file to a filespec'
  66. ' $PAGE
  67. '  SUBROUTINE NAME    -- WILDFILE
  68. '
  69. '  INPUT PARAMETERS   -- PARAMETER             MEANING
  70. '                        PATTERN$           PATTERN TO CHECK AGAINST
  71. '                        ITEM.TO.MATCH$     FILE NAME TO MATCH
  72. '
  73. '  OUTPUT PARAMETERS     DOES.MATCH         WHETHER MATCHES
  74. '
  75. '  SUBROUTINE PURPOSE  DETERMINE WHETHER A FILE NAME IS AN INSTANCE OF
  76. '  A FILE SPECIFICATION.  EXACTLY LIKE DOS EXCEPT THAT ? MUST HAVE A
  77. '  CHARACTER.
  78. '
  79. 20290 SUB WILDFILE (PATTERN$,ITEM.TO.MATCH$,DOES.MATCH) STATIC
  80.       IF PATTERN$ <> PREV.PATTERN$ THEN _
  81.          CALL BRKFNAME (PATTERN$,PDR$,PPREFIX$,PEXT$,FALSE) : _
  82.          PREV.PATTERN$ = PATTERN$
  83.       CALL BRKFNAME (ITEM.TO.MATCH$,IDR$,IPREFIX$,IEXT$,FALSE)
  84.       DOES.MATCH = FALSE
  85.       IF PDR$ <> "" AND PDR$ <> IDR$ THEN _
  86.          EXIT SUB
  87.       CALL WILDCARD (PPREFIX$,IPREFIX$)
  88.       IF NOT OK THEN _
  89.          EXIT SUB
  90.       CALL WILDCARD (PEXT$,IEXT$)
  91.       DOES.MATCH = OK
  92.       END SUB
  93. ' $SUBTITLE: 'SENDNAME - send FILENAME using EXEC-PC protocol'
  94. ' $PAGE
  95. '
  96. '  SUBROUTINE NAME    -- SENDNAME
  97. '
  98. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  99. '                        B$()                ARRAY OF FILENAME FOR AUTODOWNLOAD
  100. '                        DWN.INDEX           INDEX OF FILENAME TO TRANSFER
  101. '
  102. '  OUTPUT PARAMETERS  -- ABORT               -1 FOR AN ABORTED ATTEMPT
  103. '
  104. '  SUBROUTINE PURPOSE -- SEND THE DOWNLOAD FILENAME TO USER DURING AN
  105. '                        AUTODOWNLOAD.
  106. '
  107.       SUB SENDNAME STATIC
  108. '
  109. ' *
  110. ' *  TRANSFER FILENAME TO USER                                                *
  111. ' *         PROCESS - SEND USER THE "ALERT" CHARACTER SEQUENCE -- <ESC>OD     *
  112. ' *                   THEN THIS IS FOLLOWED BY CHARACTER-BY-CHARACTER         *
  113. ' *                   TRANSMISSION OF THE FILENAME WITH ECHO.  IF ANY OF THE  *
  114. ' *                   CHARACTERS OF THE FILENMAE ARE GARBLED A SERIES OF      *
  115. ' *                   <CAN> ARE SENT, OTHERWISE AN <ACK> IS SENT AT           *
  116. ' *                   COMPLETION AND FILE TRANSFER BEGINS.                    *
  117. ' *
  118. '
  119.       ABORT = FALSE                      ' RESET ABORT FLAG
  120.       ATTEMPTS = 0                       ' RESET COUNT FOR # OF TRANS ATTEMPTS
  121. 20295
  122. 20296
  123. 20298
  124. 20300
  125. 20305
  126. 20306
  127. 20310
  128. 20313     
  129. 20315 END SUB
  130. ' $SUBTITLE: 'UPDTUPLOAD -- Updates upload directory'
  131. ' $PAGE
  132. '  SUBROUTINE NAME    -- UPDTUPLOAD
  133. '
  134. '  INPUT PARAMETERS   -- PARAMETER             MEANING
  135. '                        FILE.NAME$
  136. '                        UPLOAD.DIRECTORY$
  137. '                        FILE.NAME.HOLD$
  138. '                        SHARE.IT
  139. '                        FMS.DIRECTORY$
  140. '                        Q!
  141. '                        TCA!
  142. '
  143. '  OUTPUT PARAMETERS  -- BYTES.IN.FILE#
  144. '                        SECONDS.PER.SESSION!
  145. '
  146. '  SUBROUTINE PURPOSE -- UPON A SUCCESSFUL UPLOAD, ADD ENTRY TO THE UPLOAD
  147. '                        DIRECTORY AND GIVE ANY SESSION TIME CREDIT.
  148. '
  149.       SUB UPDTUPLOAD (CATEGORY.NAME$(1),CATEGORY.CODE$(1),LINES.IN.DESC,FF) STATIC '<===
  150.       ON FF GOTO 20710,20724,20723,20722
  151. 20710 ABORT = FALSE    ' PE ABORT MOD
  152.        CALL QTPUT("Describe " + FILE.NAME.HOLD$ +CRLF$ + _
  153.            " (Begin with  /  if for SYSOP only) or enter ABORT to cancel",1)
  154.       CALL QTPUT(LEFT$(" |----+--Min<..-+---2+0---+---3+0---+---4+0---+-", _
  155.                  MAX.DESC.LEN - 4) + "..Max>",1)
  156.       A$ = ""
  157.       SUBROUTINE.PARAMETER = 1
  158.       PARSE.OFF = TRUE
  159.       CALL TGET
  160.       CALL CARRIER
  161.       IF SUBROUTINE.PARAMETER = -1 THEN _
  162.          B$ = "<description unavailable>": _
  163.          GOTO 20712
  164.       IF B$ = "ABORT" OR B$ = "abort" THEN _
  165.       ABORT = TRUE : _
  166.       EXIT SUB
  167.       IF LEN(B$) > MAX.DESC.LEN OR LEN(B$) < 5 THEN _
  168. CALL QTPUT (" Description must be 5 chars min," + STR$(MAX.DESC.LEN) + " chars max",1) : _ 
  169. CALL QTPUT (" ENTER the word ABORT to cancel transfer....",1) : _
  170.          GOTO 20710
  171. 20712 DESC$ = B$
  172.       IF NOT LIMIT.SEARCH.TO.FMS THEN _
  173.          IF FMS.DIRECTORY$ <> UPLOAD.DIRECTORY$ THEN _
  174.             IF LEFT$(B$,1) = "/" THEN _
  175.              GOTO 20722_
  176.             ELSE GOTO 20717
  177. '
  178. 20715  IF LEFT$(B$,1) = "/" OR LEFT$(B$,1) = "\" THEN _
  179.          B$ = MID$(B$(1),2) : _
  180.          UCAT$ = "***" : _
  181.          GOTO 20722
  182.       UCAT$ = DEFAULT.CATEGORY.CODE$
  183. 20717 IF SUBROUTINE.PARAMETER = -1 OR _
  184.       USER.SECURITY.LEVEL < SL.CATEGORIZE.UPLOADS THEN _
  185.       GOTO 20722
  186. 20719 CALL BUFFILE (UPCAT.HELP$,X)
  187. 20720 A$ = "Upload best fits what category (H=help)"
  188.       SUBROUTINE.PARAMETER = 1
  189.       CALL TGET
  190.       IF SUBROUTINE.PARAMETER = -1 THEN _
  191.          B$ = DEFAULT.CATEGORY.CODE$ : _
  192.          GOTO 20722
  193.       IF Q = 0 THEN _
  194.          GOTO 20719
  195.       CALL ALLCAPS (B$(1))
  196.       IF B$(1) = "H" OR _
  197.          B$(1) = "*" OR _
  198.          B$(1) = "?" THEN _
  199.          GOTO 20719
  200.       CALL CHKNARY (B$(1),CATEGORY.NAME$(),NUM.CATEGORIES,FOUND)
  201.       IF FOUND > 0 THEN _
  202.          UCAT$ = CATEGORY.CODE$(FOUND) : _
  203.          IF LEN(UCAT$) > 0 AND LEN(UCAT$) < 4 AND INSTR(UCAT$,",") = 0 THEN _
  204.             GOTO 20722
  205.       UCAT$ = ""
  206.       IF NOT LIMIT.SEARCH.TO.FMS THEN _
  207.          STREW.TO$ = DIRECTORY.PATH$ + _
  208.                      B$(1) + _
  209.                      "." + _
  210.                      DIRECTORY.EXTENTION$ : _
  211.          CALL FINDIT (STREW.TO$) : _
  212.          IF NOT OK THEN _
  213.             STREW.TO$ = "" _
  214.          ELSE GOTO 20722
  215.       CALL QTPUT ("No such category " + B$(1),1)
  216.       GOTO 20719
  217. 20722  IF USER.SECURITY.LEVEL >= ASK.EXTENDED.DESC AND _
  218.          MAX.EXTENDED.LINES > 0 AND SUBROUTINE.PARAMETER <> -1 THEN _
  219.          A$ = "Add an EXTENDED DESCRIPTION of " + _
  220.               FILE.NAME.HOLD$ + " (Y,[N])" : _
  221.          TURBO.KEY = -TURBO.KEY.USER : _
  222.          SUBROUTINE.PARAMETER = 1 : _
  223.          CALL TGET : _
  224.      IF SUBROUTINE.PARAMETER <> -1 THEN _
  225.         IF  YES THEN _
  226.        CALL SKIPLINE (2):_
  227.       CALL QTPUT (CHR$(7)+ " Description will be Entered AFTER the UPLOAD is Completed",2) : _
  228.     CALL DELAYIT (2) :_
  229.    GET.EXT.DESC = TRUE: _
  230.   EXIT SUB
  231.     'CALL AUTOLOGOFF      'Pe 04/09/89
  232.        EXIT SUB
  233. ' *********   routine AFTER the Upload is successfull and Extended = True *****
  234. 20723  IF NOT LIMIT.SEARCH.TO.FMS THEN _
  235.          STREW.TO$ = DIRECTORY.PATH$ + _
  236.                      B$(1) + _
  237.                      "." + _
  238.                      DIRECTORY.EXTENTION$
  239.        CALL FINDIT (STREW.TO$)
  240.          IF NOT OK THEN _
  241.             STREW.TO$ = ""
  242.       B$ = DESC$
  243.       X$ = DATE$
  244.       Z$ = LEFT$(X$,6) + _
  245.            RIGHT$(X$,2)
  246.       EN$ = STREW.TO$
  247.       GOSUB 20730
  248.       EN$ = ALWAYS.STREW.TO$
  249.       GOSUB 20730
  250.       GOTO 20726              'CHANGE from 20725 to 20726
  251. '
  252. '***** ENTRY POINT WHEN UPLOAD is Finished ***********
  253. '
  254.  20724  CALL FINDIT (FILE.NAME$)
  255.        IF NOT OK THEN _
  256.           BYTES.IN.FILE# = 0.0 _
  257.        ELSE BYTES.IN.FILE# = LOF(2)
  258.        IF BYTES.IN.FILE# < 2.0 THEN _
  259.           EXIT SUB
  260. '************************8 New Convert code begins here 8*******************
  261. ' Orig mods by Warren Muldrow
  262. '
  263. '      Zip Convert code.  Does the following:
  264. '
  265. '         .EXE files are retained as is (for self-extracting files)
  266. '
  267. '         .ZIP, .ARC, .PAK, .ZOO, and .LZH are unzrc'ed and then Zipped
  268. '
  269. '         All other files are Zipped
  270. '
  271. '      PKUNZIP, PKZIP, PKUNPAK, PAK, LHARC, ZOO.BAT, WHAT.EXE, and LOOZ.EXE
  272. '         should be in the DOS path or the RBBS directory.  WHAT is used by
  273. '         ZOO.BAT and is included in this archive.
  274. '
  275. '      The Library work path (Config parm # 304) is used for a work area
  276. '
  277.        IF ABORT = TRUE THEN _     'Corrects aborted uploads
  278.           EXIT SUB                'corrects aborted uploads
  279. '
  280. ' Allows SYSOP and users with security level to add new DIR entry
  281. ' the option to convert or not
  282. '                                  Pe 05/31/89 updated 06/12/89
  283. '
  284. IF SYSOP OR USER.SECURITY.LEVEL > = ADD.DIR.SECURITY THEN 
  285.   A$ = " Convert or verify " + FILE.NAME$ + " ([Y],N) "
  286.       SUBROUTINE.PARAMETER = 1
  287.       CALL TGET 
  288.     IF SUBROUTINE.PARAMETER = -1 THEN _
  289.      EXIT SUB
  290.    IF NO THEN _
  291.         GOTO 20725
  292. END IF
  293.  
  294. 'End of 05/31/89 mod
  295. '
  296.        CALL BRKFNAME (FILE.NAME$, DR$, ZZ$, X$, TRUE)
  297.        IF X$ = ".EXE" OR X$ = "" OR EXT$ = ".SFX" THEN _
  298.           GOTO 20725
  299.        IF X$ = ".ZIP" THEN _
  300.           CALL QTPUT (FILE.NAME.HOLD$ +" Now being verified and re-Zipped Please wait!",1) : _
  301.           Z$ = "PKUNZIP -x " + FILE.NAME$ + " " _
  302.        ELSE _
  303.           CALL QTPUT (FILE.NAME.HOLD$ +" Now being converted to .ZIP format. Please wait!",1) : _
  304.           IF X$ = ".ARC" OR X$ = ".PAK" THEN _
  305.              Z$ = "PAK e " + FILE.NAME$ + " " : _
  306.           ELSE IF X$ = ".LZH" THEN _
  307.              Z$ = "LHARC e " + FILE.NAME$ + " " : _
  308.           ELSE IF X$ = ".ZOO" THEN _
  309.              Z$ = "ZOO.BAT " + FILE.NAME$ + " " : _
  310.           ELSE _
  311.              SHELL "PKZIP -m -ex " + DR$ + ZZ$ + " " + FILE.NAME$ : _ 
  312.              Z$ = "" :
  313.        IF Z$ <> "" THEN _
  314.           SHELL "MD " + LIBRARY.WORK.DISK.PATH$ + NODE.ID$ : _
  315.           SHELL Z$ + " " + LIBRARY.WORK.DISK.PATH$ + NODE.ID$ + "\" : _
  316.           SHELL "DEL " + FILE.NAME$ : _
  317.           SHELL "PKZIP -m -ex " + DR$ + ZZ$ + " " + _ 
  318.                  LIBRARY.WORK.DISK.PATH$ + NODE.ID$ + "\*.*" : _
  319.        SHELL "RD " + LIBRARY.WORK.DISK.PATH$ + NODE.ID$
  320.        FILE.NAME.HOLD$ = ZZ$ + ".ZIP"
  321.        FILE.NAME$ = DR$ + FILE.NAME.HOLD$
  322. '
  323. '
  324. ' Comment code added here
  325. '
  326.     CALL FINDIT (FILE.NAME$)
  327.       IF OK THEN
  328.        CLOSE 2
  329.      COMMENT.NAME$ = UPLOAD.SUBDIR$ +"\UPLOAD.CMT
  330.      ADDCMT1$ =CRLF$ +"Uploaded to "+ RBBS.NAME$ +" By: "+ACTIVE.USER.NAME$
  331.      ADDCMT2$ = CRLF$ +"Description: " + DESC$
  332.      ADDCOMMENT$ =  ADDCMT1$ + ADDCMT2$ + CRLF$
  333.           CALL OPENOUTW (COMMENT.NAME$)
  334.          PRINT #2, ADDCOMMENT$
  335.        CLOSE 2
  336.       ADDCMT$ = LIBRARY.ARCHIVE.PATH$+"PKZIP -z<"+COMMENT.NAME$+" "+ FILE.NAME$
  337.    SHELL ADDCMT$ 
  338. END IF
  339.        CALL FINDIT (FILE.NAME$)
  340.        IF NOT OK THEN _
  341.           BYTES.IN.FILE# = 0.0 _
  342.        ELSE BYTES.IN.FILE# = LOF(2)
  343.        CLOSE 2
  344.        IF BYTES.IN.FILE# < 2.0 THEN _
  345.           EXIT SUB
  346. 20725 CALL QTPUT(CX$(5)+"Upload successful,Thanks for the file "+CX$(2) + FIRST.NAME$+CX$(7),1)
  347.       IF GET.EXT.DESC THEN _
  348.          EXIT SUB     
  349.        X$ = DATE$
  350.        Z$ = LEFT$(X$,6) + RIGHT$(X$,2)
  351.        STREW.TO$ = ""
  352.        B$ = DESC$
  353.        EN$ = ALWAYS.STREW.TO$
  354.        GOSUB 20730
  355.        EN$ = STREW.TO$
  356.        GOSUB 20730 
  357. '
  358. 'VVVV  NEW LINE NUMBER ONLY--- was 20725
  359. 'vvvv
  360. 20726  IF FMS.DIRECTORY$ <> UPLOAD.DIRECTORY$ THEN _ 
  361.           IF LEFT$(B$,1) = "/" OR LEFT$(B$,1) = "\" THEN _
  362.              CALL UPDTCALR (B$,2): _
  363.              GOTO 20727
  364. '******************  End of Convert mods 05/10/89  **************
  365.   EN$ = UPLOAD.DIRECTORY$
  366.        GOSUB 20730
  367. 20727 DF$ = " >> uploaded << "
  368.       UPLOADS = UPLOADS + 1
  369.       GLOBAL.UPLOADS = GLOBAL.UPLOADS + 1
  370.       ULBYTES! = ULBYTES! + BYTES.IN.FILE#
  371.       GLOBAL.ULBYTES! = GLOBAL.ULBYTES! + BYTES.IN.FILE#
  372.       CALL TIMEREMAIN (TIME.REMAINING!)
  373.       IF PRIVATE.DOOR THEN _                                         ' KG101505
  374.          X! = UPLOAD.TIME.FACTOR! * Q! _                             ' KG101505
  375.       ELSE X! = UPLOAD.TIME.FACTOR! * (TCA! - Q!)                    ' KG101505
  376.       TIME.CREDITS! = TIME.CREDITS! + X!
  377.       SECONDS.PER.SESSION! = SECONDS.PER.SESSION! + X!
  378.       IF PRIVATE.DOOR THEN _                                         ' KG101505
  379.          X! = (X! - Q!) / 60.0 _                                     ' KG101505
  380.       ELSE X! = (X! - TCA! + Q!)/60.0                                ' KG101505
  381.       X$ = STR$(FIX(X!*10.0))                                        ' KG110505
  382.       X$ = LEFT$(X$,LEN(X$)-1) + "." + RIGHT$(X$,1)                  ' KG110505
  383.       IF X! > 1.0 THEN _
  384.          CALL QTPUT ("Uploads are appreciated here.  For today your",1) : _
  385.          CALL QTPUT ("SESSION & DAILY time limits increased by "+X$+" minutes",1)
  386.       X$ = ""                  'PE11/14/88
  387.   GET.EXT.DESC = FALSE
  388.  IF  AUTO.END = 1 THEN _
  389.     FILESYS.PARAMETER = 7 : _           'Pe 02/05/89
  390.     DOWNLOAD.COMPLETED = TRUE           'Pe 02/06/89 Fixes the fix
  391.       EXIT SUB
  392. 20730 '          ---[ lock file ]---
  393.       IF EN$ = "" THEN _
  394.          RETURN
  395.       FMS.FORMAT = FALSE
  396.       IF EN$ = FMS.DIRECTORY$ OR LIMIT.SEARCH.TO.FMS THEN _
  397.          FMS.FORMAT = TRUE _
  398.       ELSE CALL FINDIT (EN$) : _
  399.            IF OK THEN _
  400.               CALL READDIR (1) : _
  401.               IF EC = 0 THEN _
  402.                  FMS.FORMAT = (LEFT$(A$,4) = "\FMS")
  403.       IF NOT FMS.FORMAT THEN _
  404.          READ.BACKWARDS = FALSE : _
  405.          FIXED.LEN = 0 : _
  406.          B$ = DESC$ _
  407.       ELSE FIXED.LEN = 34 + MAX.DESC.LEN : _
  408.            B$ = DESC$ + _
  409.                 SPACE$(MAX.DESC.LEN - LEN(DESC$)) + _
  410.                 UCAT$ + _
  411.                 SPACE$(3 - LEN(UCAT$)) : _
  412.            READ.BACKWARDS = TRUE : _
  413.            CALL FINDIT (EN$) : _
  414.            IF OK THEN _
  415.               CALL READDIR (1) : _
  416.               IF EC = 0 THEN _
  417.                  READ.BACKWARDS = (INSTR(A$," TOP ") = 0)
  418.       BX = &H4
  419.       SUBROUTINE.PARAMETER = 9
  420.       CALL FILELOCK
  421. '* ------[ first line different ]------
  422.       EC = 0                                                         ' KG103001
  423.       CALL OPENWRKA (EN$)                                            ' KG102506
  424.       IF EC <> 0 THEN _                                              ' KG103001
  425.          GOTO  20731                                                 ' KG103001
  426.      '          ---[ append ]---
  427.       IF GET.EXT.DESC THEN _
  428.          IF READ.BACKWARDS THEN _
  429.             FOR I = LINES.IN.DESC TO 1 STEP -1 : _
  430.                GOSUB 20732 : _
  431.             NEXT
  432.       PRINT #2,USING "\           \########  &  &"; _
  433.                      FILE.NAME.HOLD$; _
  434.                      BYTES.IN.FILE#; _
  435.                      Z$; _
  436.                      B$
  437.       IF GET.EXT.DESC THEN _
  438.          IF NOT READ.BACKWARDS THEN _
  439.             FOR I = 1 TO LINES.IN.DESC : _
  440.                GOSUB 20732 : _
  441.             NEXT
  442.  20731 CLOSE 2               'KG1030001
  443.       '          ---[ unlock ]---
  444.       BX = &H4
  445.       SUBROUTINE.PARAMETER = 10
  446.       CALL FILELOCK
  447.       FIXED.LEN = 0
  448.       RETURN
  449. 20732 X$ = A$(I)
  450.       CALL TRIM (X$)
  451.       IF X$ = "" THEN _
  452.          RETURN
  453.       IF NOT FMS.FORMAT THEN _
  454.          PRINT #2,"  ";A$(I) : _
  455.          RETURN
  456.       IF FIXED.LEN > LEN(A$(I)) THEN _
  457.          X$ = SPACE$(FIXED.LEN - 1 - LEN(A$(I))) + "." _
  458.       ELSE X$ = ""
  459.       PRINT #2, "  ";LEFT$(A$(I),FIXED.LEN);X$
  460.       RETURN
  461.       END SUB
  462. ' $SUBTITLE: 'BADFILE - subroutine to find bad file names'
  463. ' $PAGE
  464. '
  465. '  SUBROUTINE NAME    -- BADFILE
  466. '
  467. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  468. '                        VIOLATION$
  469. '                        VIOLATIONS.THIS.SESSION
  470. '                        FILNAME$                      NAME OF FILE
  471. '
  472. '  OUTPUT PARAMETERS  -- RESULT                      1 = FILE NAME IS OK
  473. '                                                    2 = CHARACTER NOT ALLOWED
  474. '                                                    3 = SYSTEM CRASH ATTEMPT
  475. '                        VIOLATIONS.THIS.SESSION     NUMBER OF VIOLATIONS
  476. '                        FILNAME$                    Gets capitalized
  477. '
  478. '  SUBROUTINE PURPOSE -- TO PROTECT RBBS-PC AGAINST THE USE OF BAD FILE NAMES
  479. '                        TO EITHER CRASH THE SYSTEM OR TO BREACH RBBS-PC'S
  480. '                        SECURITY
  481. '
  482.       SUB BADFILE (FILNAME$,RESULT) STATIC
  483. '
  484. ' *
  485. ' *  TEST FOR INVALID CHARACTERS IN FILENAME                                  *
  486. ' *
  487. '
  488. 20741 RESULT = 2
  489.       IF LEN(FILNAME$) < 1 THEN _
  490.          EXIT SUB
  491.       CALL ALLCAPS (FILNAME$)
  492.       IF INSTR(FILNAME$,"?") OR _
  493.          INSTR(FILNAME$,"*") OR _
  494.          INSTR(FILNAME$," ") OR _
  495.          INSTR(3,FILNAME$,":") OR _
  496.          INSTR(FILNAME$,".DEF") OR _
  497.          INSTR(FILNAME$,".MNU") OR _
  498.          INSTR(FILNAME$,".OLD") OR _
  499.          INSTR(FILNAME$,".PUI") OR _
  500.          MID$(FILNAME$,LEN(FILNAME$),1) = "." THEN _
  501.            EXIT SUB
  502.       XX = INSTR(FILNAME$,".")
  503.       IF XX > 0 THEN _
  504.          XX = INSTR(XX + 1,FILNAME$,".") : _
  505.          IF XX > 0 THEN _
  506.             EXIT SUB
  507.       XX = LEN(FILNAME$)
  508.       IF XX => 3 THEN _
  509.          IF INSTR("PRN:CON:AUX:NUL:",FILNAME$) THEN _
  510.             GOTO 20742
  511.       IF XX => 4 THEN _
  512.          IF INSTR("COM1:COM2:LPT1:LPT2:LPT3:SCRN:KYBD:CONS:",FILNAME$) THEN _
  513.             GOTO 20742
  514.       CALL BRKFNAME (FILNAME$,PRE$,BODY$,EXT$,FALSE)
  515.       IF LEN(PRE$) > 64 OR LEN(BODY$) > 8 OR LEN(BODY$) < 1 OR LEN(EXT$) > 3 THEN _
  516.          EXIT SUB
  517.       XX = LEN(BODY$)
  518.       IF XX => 3 THEN _
  519.          IF INSTR("PRN:CON:AUX:NUL:",BODY$) THEN _
  520.             GOTO 20742
  521.       IF XX => 4 THEN _
  522.          IF INSTR("COM1:COM2:LPT1:LPT2:LPT3:SCRN:KYBD:CONS:",BODY$) THEN _
  523.             GOTO 20742
  524.       RESULT = 1
  525.       EXIT SUB
  526. 20742 VIOLATIONS.THIS.SESSION = MAXIMUM.VIOLATIONS
  527.       VIOLATION$ = VIOLATION$ + _
  528.                    FILNAME$
  529.       RESULT = 3
  530.       END SUB
  531. '
  532. ' $SUBTITLE: 'LIBRARY - subroutine to support Library downloads'
  533. ' $PAGE
  534. '
  535. '  SUBROUTINE NAME    -- LIBRARY
  536. '
  537. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  538. '                            SUBROUTINE.PARAMETER     1 = DISPLAY ACTIVE AREA
  539. '                                                     2 = CHANGE ACTIVE AREA
  540. '                                                     3 = DISPLAY PC-SIG
  541. '                                                         DISCLAIMER
  542. '                                                     4 = ARCHIVE LIBRARY DISK
  543. '                                                     5 = DOWNLOAD COMPLETED
  544. '                            LIBRARY.TYPE             0 = NO LIBRARY ACTIVE
  545. '                                                     1 = LIBRARY FROM PC-SIG
  546. '                            LIBRARY.DRIVE$           LIBRARY DRIVE ID
  547. '
  548. '  OUTPUT PARAMETERS  -- NONE
  549. '
  550. '  SUBROUTINE PURPOSE -- TO PROVIDE ACCESSS SUPPORT FOR LIBRARY DRIVES
  551. '
  552.       SUB LIBRARY STATIC
  553.       STATIC LIBRARY.SUBDIR.NAME$(1)
  554.       STATIC DISK.TITLE$
  555.       EC = 0
  556. 21105 IF LIBRARY.TYPE = 0 THEN _
  557.          EXIT SUB
  558.       IF LIBRARY.DISK.CHAR$ = "" THEN _
  559.          LIBRARY.DISK.CHAR$ = "0000"
  560.       ON SUBROUTINE.PARAMETER GOTO 21110, 21115, 21130, 21140, 21159
  561. 21110 IF LIBRARY.DISK.CHAR$ = "0000" THEN _
  562.          A$ = "No Library disk currently selected" _
  563.       ELSE A$ = "Library disk " + _
  564.                 LIBRARY.DISK.CHAR$ + _
  565.                 " selected - " + _
  566.                 DISK.TITLE$
  567.       CALL QTPUT (A$,1)
  568.       IF LIBRARY.DISK.ARCHIVE$ = "" THEN _
  569.          EXIT SUB
  570.       FOR LIBRARY.DISPLAY.COUNT = 0 TO LIBRARY.LOOP.COUNT - 1
  571.          IF LIBRARY.SUBDIR.NAME$(LIBRARY.DISPLAY.COUNT) <> "" THEN _
  572.             CALL QTPUT (LIBRARY.SUBDIR.NAME$(LIBRARY.DISPLAY.COUNT) + _
  573.                        ".ARC ready for transmission!",1)
  574.       NEXT
  575.       EXIT SUB
  576. 21115 IF Q = 1 THEN _
  577.          A$ = "Change Library disk from " + _
  578.               LIBRARY.DISK.CHAR$ + _
  579.               " to (1 -" + _
  580.               STR$(LIBRARY.MAX.DISK) + _
  581.               ")" : _
  582.          SUBROUTINE.PARAMETER = 1 : _
  583.          CALL TGET : _
  584.          IF SUBROUTINE.PARAMETER = -1 THEN _                         ' JM120601
  585.             EXIT SUB _                                               ' JM120601
  586.          ELSE IF Q = 0 THEN _                                        ' JM120601
  587.                  LIBRARY.DISK.CHAR$ = "0000" : _                     ' JM120601
  588.                  CHDIR.LIBRARY$ = LIBRARY.DRIVE$ + _                 ' JM120601
  589.                                   "\" : _                            ' JM120601
  590.                  GOTO 21126                                          ' JM120601
  591. 21117 IF VAL(B$(Q)) < 1 OR VAL(B$(Q)) > LIBRARY.MAX.DISK THEN _
  592.          Q = 1 : _
  593.          GOTO 21115
  594. 21120 LIBRARY.DISK.CHAR$ = B$(Q)
  595.       CLOSE 2
  596.       LIBRARY.DISK.CHAR$ = RIGHT$("0000" + LIBRARY.DISK.CHAR$,4)
  597. 21121 CALL FINDIT("RBBS-CDR.DEF")
  598.       IF EC <> 0 THEN _
  599.          EXIT SUB
  600. 21122 IF EOF(2) THEN _
  601.          LIBRARY.DISK.CHAR$ = "" : _
  602.          EXIT SUB
  603.       INPUT #2,WORK.SUBDIR$,CHDIR.LIBRARY$
  604.       LINE INPUT #2,DISK.TITLE$
  605.       IF LIBRARY.DISK.CHAR$ = WORK.SUBDIR$ THEN _
  606.          CHDIR.LIBRARY$ = LIBRARY.DRIVE$ + _
  607.                           CHDIR.LIBRARY$ : _
  608.          GOTO 21126
  609.       GOTO 21122
  610. 21126 EC = 0
  611.       CALL CHANGEDIR (CHDIR.LIBRARY$)
  612.       IF EC <> 0 THEN _
  613.          LIBRARY.DISK.CHAR$ = "0000" : _
  614.          CHDIR.LIBRARY$ = LIBRARY.DRIVE$ + _
  615.                           "\" : _
  616.          GOTO 21126
  617.       EXIT SUB
  618. 21130 IF LIBRARY.TYPE <> 1 THEN _
  619.          EXIT SUB
  620.       CALL SKIPLINE(1)
  621.       A$ = "PC-SIG Library is being accessed.  The file that you are about"
  622.       CALL QTPUT (A$,1)
  623.       A$ = "to download can also be obtained by ordering DISK " + _
  624.            LIBRARY.DISK.CHAR$
  625.       CALL QTPUT (A$,1)
  626.       A$ = "from PC-SIG, 1030D East Duane Ave. Sunnyvale, Ca. 94086"
  627.       CALL QTPUT (A$,2)
  628.       EXIT SUB
  629. 21140 IF LIBRARY.DISK.CHAR$ = "0000" THEN _
  630.          CALL QTPUT ("You must select a LIBRARY disk first!",1) : _
  631.          EXIT SUB
  632.       A$ = "Archive contents of Library disk - " + _
  633.            LIBRARY.DISK.CHAR$ + _
  634.            " for data transmission (Y/[N])"
  635.       SUBROUTINE.PARAMETER = 1
  636.       CALL TGET
  637.       IF NOT LOCAL.USER THEN _
  638.          IF SUBROUTINE.PARAMETER = -1 THEN _        'JM120601
  639.             EXIT SUB
  640.       IF NOT YES THEN _
  641.          EXIT SUB
  642. 21145 CALL KILLWORK (LIBRARY.WORK.DISK.PATH$ + _
  643.                     LIBRARY.NODE.ID$ + _
  644.                     "DK*.ARC")
  645. 21150 CALL QTPUT ("Work/RAM disk has been purged",1)
  646.       CALL QTPUT ("Beginning archive using " + _
  647.                   LIBRARY.ARCHIVE.PROGRAM$ + _
  648.                   " Please be patient!",1)
  649.       REDIM LIBRARY.SUBDIR.NAME$(10)
  650.       LIBRARY.SUBDIR.CHAR$ = ""
  651.       LIBRARY.LOOP.COUNT = 0
  652.       GOSUB 21157
  653.       A$ = "Contents of Library disk - " + _
  654.            LIBRARY.DISK.CHAR$ + _
  655.            " now archived for data transmission"
  656.       CALL QTPUT (A$,1)
  657.       A$ = "Searching for Sub-directories"
  658.       CALL QTPUT (A$,1)
  659.       GOSUB 21158
  660.       LIBRARY.DISK.ARCHIVE$ = LIBRARY.DISK.CHAR$
  661. '
  662. ' SEARCH AND ARCHIVE ANY SUBDIRECTORIES
  663. '
  664.       TREEDIR$ = LIBRARY.WORK.DISK.PATH$ + _
  665.                  LIBRARY.NODE.ID$ + _
  666.                  "DKDIR.LST"
  667.       DIRCMD$ = "DIR " + _
  668.                 LIBRARY.DRIVE$ + _
  669.                 " | FIND " +  _
  670.                 CHR$(34) + _
  671.                 " <DIR> " + _
  672.                 CHR$(34) + _
  673.                 "  > " + _
  674.                 TREEDIR$
  675. 21151 SHELL DIRCMD$
  676.       CALL SKIPLINE (2)
  677.       LOCATE 24,1
  678.       EC = 0
  679. 21152 CLOSE 2
  680. 21153 CALL OPENWORK (TREEDIR$)                                       ' LP102201
  681.       LIBRARY.SUBDIR.COUNT = 0
  682.       WHILE NOT EOF(2)
  683.          LINE INPUT #2, DIRREC$
  684.          IF LEFT$(DIRREC$,1) <> "." THEN _
  685.             LIBRARY.SUBDIR.COUNT = LIBRARY.SUBDIR.COUNT + 1 : _
  686.             LIBRARY.SUBDIR.NAME$(LIBRARY.SUBDIR.COUNT) = _
  687.             LEFT$(DIRREC$,8)
  688.       WEND
  689.       CLOSE 2
  690.       LIBRARY.LOOP.COUNT = 1
  691.       IF LIBRARY.SUBDIR.COUNT = 0 THEN _
  692.          GOTO 21156
  693.       A$ = "There are" + STR$(LIBRARY.SUBDIR.COUNT) + _
  694.            " Subdirectories on LIBRARY disk - " + _
  695.            LIBRARY.DISK.CHAR$
  696.       CALL QTPUT(A$,1)
  697.       FOR LIBRARY.LOOP.COUNT = 1 TO LIBRARY.SUBDIR.COUNT
  698.          IF NOT LOCAL.USER THEN _
  699.             CALL CARRIER : _
  700.             IF SUBROUTINE.PARAMETER THEN _
  701.                GOTO 21155
  702.          LIBRARY.SUBDIR.CHAR$ = MID$("ABCDEFGHI",LIBRARY.LOOP.COUNT,1)
  703.          A$ = "Creating " + _
  704.               LIBRARY.NODE.ID$ + _
  705.               "DK" + _
  706.               LIBRARY.DISK.CHAR$ + _
  707.               LIBRARY.SUBDIR.CHAR$ + _
  708.               ".ARC using " + LIBRARY.ARCHIVE.PROGRAM$
  709.          CALL QTPUT(A$,1)
  710.          CHDIR CHDIR.LIBRARY$ + _
  711.                "\" + _
  712.                LIBRARY.SUBDIR.NAME$(LIBRARY.LOOP.COUNT)
  713.          GOSUB 21157
  714.          A$ = "Disk - " + _
  715.               LIBRARY.DISK.CHAR$ + _
  716.               "; Subdirectory" + _
  717.               " -" + _
  718.               STR$(LIBRARY.LOOP.COUNT) + _
  719.               " has been archived for data transmission"
  720.          CALL QTPUT(A$,1)
  721.          GOSUB 21158
  722. 21155 NEXT LIBRARY.LOOP.COUNT
  723. 21156 CALL CARRIER
  724.       A$ = ""
  725.       EXIT SUB
  726. 21157 LIBRARY.ARCHIVE$ = LIBRARY.ARCHIVE.PATH$ + _
  727.                        LIBRARY.ARCHIVE.PROGRAM$ + _
  728.                        " " + _
  729.                        LIBRARY.WORK.DISK.PATH$ + _
  730.                        LIBRARY.NODE.ID$ + _
  731.                        "DK" + _
  732.                        LIBRARY.DISK.CHAR$ + _
  733.                        LIBRARY.SUBDIR.CHAR$ + _
  734.                        " " + _
  735.                        LIBRARY.DRIVE$ + _
  736.                        "*.*"
  737.       IF USE.DEVICE.DRIVER$ <> "" AND FOSSIL THEN _                  ' JM110901
  738.          LIBRARY.ARCHIVE$ = DISK.FOR.DOS$ + _                        ' JM110901
  739.                             "COMMAND /C " + _                        ' JM110901
  740.                             LIBRARY.ARCHIVE$ + _                     ' JM110901
  741.                             " > " + _                                ' JM110901
  742.                             USE.DEVICE.DRIVER$                       ' JM110901
  743.       SHELL LIBRARY.ARCHIVE$
  744.       CALL SKIPLINE (2)
  745.       LOCATE 24,1
  746.       RETURN
  747. 21158 LIBRARY.SUBDIR.NAME$(LIBRARY.LOOP.COUNT) = LIBRARY.NODE.ID$ + _
  748.                                              "DK" + _
  749.                                              LIBRARY.DISK.CHAR$ + _
  750.                                              LIBRARY.SUBDIR.CHAR$
  751.       RETURN
  752. 21159 FOR LIBRARY.DISPLAY.COUNT = 0 TO LIBRARY.LOOP.COUNT - 1
  753.          IF LIBRARY.SUBDIR.NAME$(LIBRARY.DISPLAY.COUNT) = A$ THEN _
  754.             LIBRARY.SUBDIR.NAME$(LIBRARY.DISPLAY.COUNT) = ""
  755.       NEXT
  756.       END SUB
  757. ' $SUBTITLE: 'XFERTYPE - subroutine to identify file xfer protocol'
  758. ' $PAGE
  759. '
  760. '  SUBROUTINE NAME    -- XFERTYPE
  761. '
  762. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  763. '                        A$
  764. '                        B$(1)
  765. '                        KERMIT.SUPPORT
  766. '                        Q
  767. '                        RELIABLE.MODE
  768. '                        TRANSFER.OPTIONS$
  769. '                        USER.TRANSFER.DEFAULT$
  770. '                        XWMODEM.SUPPORT
  771. '                        XFER.SUPPORT
  772. '
  773. '  OUTPUT PARAMETERS  -- CHECKSUM
  774. '                        FLEN
  775. '                        FT$
  776. '
  777. '  SUBROUTINE PURPOSE -- TO IDENTIFY THE FILE TRANSFER PROTOCOL (EITHER
  778. '                        FROM THE USER'S DEFAULT OR VIA EXPLICIT SELECTION)
  779. '
  780.       SUB XFERTYPE(INDEX,SKIP.HELP) STATIC
  781.       IF USER.SECURITY.LEVEL <> PREV.USL THEN _
  782.          CALL PROTOCOL : _
  783.          PREV.USL = USER.SECURITY.LEVEL
  784.       X$ = A$ + "Protocol"
  785.       ON INDEX GOTO 21600,21620
  786. '
  787. ' *
  788. ' *  MANUAL SELECT OF TRANSFER PROTOCOL                                       *
  789. ' *
  790. '
  791. 21600 IF SKIP.HELP THEN _
  792.          GOTO 21604
  793. 21602 CALL BUFFILE (HELP.PATH$ + "UF" + HELP.EXTENSION$,X)
  794.       IF SUBROUTINE.PARAMETER = -1 THEN _
  795.          EXIT SUB
  796. 21604 CALL QTPUT (X$,1)
  797.       STOP.INTERRUPTS = TRUE
  798.       CALL BUFSTRNG (TRANSFER.OPTIONS$,4096,X)
  799.       A$ = ""
  800.       TURBO.KEY = -TURBO.KEY.USER
  801.       SUBROUTINE.PARAMETER = 1
  802.       CALL TGET
  803.       IF SUBROUTINE.PARAMETER = -1 THEN _
  804.          EXIT SUB
  805.       IF Q = 0 THEN _
  806.          GOTO 21604
  807.       Z$ = B$(1)
  808. '
  809. ' *
  810. ' *  DEFAULT SELECT OF TRANSFER PROTOCOL                                      *
  811. ' *
  812. '
  813. 21610 CALL ALLCAPS (Z$)
  814.       IF INSTR("H?",Z$) > 0 THEN _
  815.          GOTO 21602
  816.       FF = INSTR(DFLTXFER$,Z$)
  817.       IF FF < 1 THEN _
  818.          GOTO 21600
  819. 21612 FT$ = MID$(DFLTXFER$,FF,1)
  820.       INTERNAL.PROTO$ = MID$(INTERNAL.EQUIV$,FF,1)      'JM110802
  821.       GOTO 21621
  822. 21620 FF = -1
  823.       IF COMMAND.TRANSFER$ <> "" THEN _
  824.          Z$ = COMMAND.TRANSFER$ : _
  825.          GOTO 21610
  826.       X = INSTR(DFLTXFER$,USER.TRANSFER.DEFAULT$)
  827.       IF X > 0 THEN _
  828.          IF MID$(INTERNAL.EQUIV$,X,1) <> "N" THEN _
  829.             Z$ = USER.TRANSFER.DEFAULT$ : _
  830.             GOTO 21610
  831.       PROTO.PROMPT$ = "None"
  832.       FF = 0
  833.       EXIT SUB
  834. 21621 IF FF = PREV.FF AND PREV.PROTO.DEF$ = PROTO.DEF$ THEN _
  835.          PROTO.PROMPT$ = PREV.PROTO.PROMPT$ : _
  836.          EXIT SUB
  837.       PREV.FF = FF
  838.       PREV.PROTO.DEF$ = PROTO.DEF$
  839.       INTERNAL.PROTO$ = MID$(INTERNAL.EQUIV$,FF,1)
  840.       CHECKSUM = (INTERNAL.PROTO$ = "X")
  841.       CALL FINDIT (PROTO.DEF$)
  842.       IF OK THEN _
  843.          GOTO 21623
  844.       X = INSTR("AXCYN",INTERNAL.PROTO$)
  845.       IF X < 1 THEN _
  846.          INTERNAL.PROTO$ = "N"
  847.       PROTO.PROMPT$ = MID$("Ascii     Xmodem    Xmodem/CRCYmodem    None",10*INSTR("AXCYN",INTERNAL.PROTO$)-9,10)
  848.       CALL TRIMTRAIL (PROTO.PROMPT$," ")
  849.       CHECKSUM = (INTERNAL.PROTO$ = "X")
  850.       FLEN = 128 - 896 * (INTERNAL.PROTO$ = "Y")
  851.       BLOCK.SIZE = FLEN
  852.       IF INTERNAL.PROTO$ = "Y" THEN _
  853.          SPEED.FACTOR! = 0.87 _
  854.       ELSE IF INTERNAL.PROTO$ = "A" THEN _
  855.          SPEED.FACTOR! = 0.92 _
  856.       ELSE SPEED.FACTOR! = 0.78
  857.       GOTO 21625
  858. 21623 CALL READPARMS (WORK.ARA$(),13,FF)
  859.       IF EC > 0 THEN _
  860.          FF = LEN(DFLTXFER$) : _
  861.          EXIT SUB
  862.       PROTO.PROMPT$ = WORK.ARA$(1)
  863.       IF LEN(PROTO.PROMPT$) > 2 THEN _
  864.          IF MID$(PROTO.PROMPT$,2,1) = ")" THEN _
  865.             PROTO.PROMPT$ = LEFT$(PROTO.PROMPT$,1) + MID$(PROTO.PROMPT$,3)
  866.       X = INSTR(PROTO.PROMPT$+CRLF$,CRLF$)
  867.       PROTO.PROMPT$ = LEFT$(PROTO.PROMPT$,X-1)
  868.       CALL TRIM (PROTO.PROMPT$)
  869.       PROTO.METHOD$ = LEFT$(WORK.ARA$(3),1)
  870.       CALL ALLCAPS (PROTO.METHOD$)
  871.       REQ.8.BIT = (LEFT$(WORK.ARA$(4),1) = "8")
  872.       DOWN.TEMPLATE$ = WORK.ARA$(12)
  873.       UP.TEMPLATE$ = WORK.ARA$(13)
  874.       X$ = WORK.ARA$(11)
  875.       X = INSTR(X$,"=")
  876.       ADVANCE.PROTO.WRITE = FALSE
  877.       IF X < 2 OR X >= LEN(X$) THEN _
  878.          FAILURE.PARM = 4 : _
  879.          FAILURE.STRING$ = "F" _
  880.       ELSE FAILURE.PARM = VAL(LEFT$(X$,X-1)) : _
  881.            FAILURE.STRING$ = MID$(X$,X+1) : _
  882.            X = INSTR(FAILURE.STRING$,"=") : _
  883.            IF X > 0 THEN _
  884.               ADVANCE.PROTO.WRITE = (MID$(FAILURE.STRING$,X) = "=A") : _
  885.               FAILURE.STRING$ = LEFT$(FAILURE.STRING$,X-1)
  886.       PROTO.MACRO$ = WORK.ARA$(10)
  887.       FAKE.XRPT = (LEFT$(WORK.ARA$(8),1) = "F")
  888.       BATCH.PROTO = (LEFT$(WORK.ARA$(6),1) = "B")
  889.       SPEED.FACTOR! = VAL(WORK.ARA$(9))
  890.       IF SPEED.FACTOR! < 0.1 THEN _
  891.          SPEED.FACTOR! = 0.87
  892.       BLOCK.SIZE = VAL(WORK.ARA$(7))
  893.       FLEN = BLOCK.SIZE
  894.       IF FLEN < 1 THEN _
  895.          FLEN = 128
  896. 21625 PREV.PROTO.PROMPT$ = PROTO.PROMPT$
  897.       END SUB
  898. ' $SUBTITLE: 'FILELOCK - subroutine to share RBBS-PC files'
  899. ' $PAGE
  900. '
  901. '  SUBROUTINE NAME    -- FILELOCK
  902. '
  903. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  904. '                        SUBROUTINE.PARAMETER = 1 UNLOCK USERS AND MESSAGES
  905. '                                               2 FLUSH MESSAGE RECORD TO DISK
  906. '                                                 AND UNLOCK MESSAGES
  907. '                                               3 LOCK MESSAGE FILE
  908. '                                               4 UNLOCK MESSAGE FILE
  909. '                                               5 LOCK USER FILE
  910. '                                               6 LOCK 4 RECORD BLOCK IN USER
  911. '                                                 FILE
  912. '                                               7 UNLOCK USER FILE
  913. '                                               8 UNLOCK 4 RECORD BLOCK IN USER
  914. '                                                 FILE
  915. '                                               9 LOCK UPLOAD DIRECTORY OR
  916. '                                                 COMMENTS FILE
  917. '                                              10 UNLOCK UPLOAD DIRECTORY OR
  918. '                                                 COMMENTS FILE
  919. '                        ACTIVE.MESSAGE FILE$   NAME OF MESSAGE FILE
  920. '                        ACTIVE.USER.FILE$      NAME OF USER FILE
  921. '                        CONFIG.FILE.NAME$      FILE NAME TO FLUSH RECORD FROM
  922. '                        EN$                    UPLOAD DIRECTORY OR COMMENTS
  923. '                                               FILE NAME TO LOCK/UNLOCK
  924. '                        NETWORK.TYPE           TYPE OF NETWORK LOCKING TO USE
  925. '
  926. '  OUTPUT PARAMETERS  -- SUBROUTINE.PARAMETER = -1 TERMINATE RBBS-PC IMMEDATELY
  927. '                        BLK
  928. '                        LOCK.DRIVE
  929. '                        LOCK.FILE.NAME$
  930. '                        LOCK.STATUS$
  931. '                        MESSAGE.FILE.LOCK
  932. '                        USER.BLOCK.LOCK
  933. '                        USER.FILE.LOCK
  934. '                        USER.FILE.INDEX
  935. '
  936. '  SUBROUTINE PURPOSE -- TO LOCK AND UNLOCK THE SHARED RBBS-PC FILES WHEN
  937. '                        MULTIPLE COPIES OF RBBS-PC ARE SHARING THE SAME
  938. '                        FILES IN EITHER A MULTI-TASKING DOS ENVIRONMENT OR
  939. '                        IN A LOCAL AREA NETWORK ENVIRONMENT
  940.       SUB FILELOCK STATIC
  941.       ON SUBROUTINE.PARAMETER GOSUB 21995,21996,22000,25000,26000, _
  942.                                     26500,27000,27500,29000,29500
  943.       EXIT SUB
  944. '
  945. ' *
  946. ' *  UNLOCK USERS AND MESSAGES                                                *
  947. ' *
  948. '
  949. 21995 GOSUB 27000
  950.       GOSUB 25000
  951.       RETURN
  952. '
  953. ' *
  954. ' *  FLUSH MESSAGE FILE DATA TO DISK BY OPENING DUMMY FILE # 1                *
  955. ' *
  956. '
  957. 21996 CLOSE 1
  958.       IF SHARE.IT THEN _
  959.          OPEN CONFIG.FILENAME$ FOR INPUT SHARED AS #1 _
  960.       ELSE OPEN "I",1,CONFIG.FILENAME$
  961. '
  962. ' *
  963. ' *  UNLOCK MESSAGES                                                          *
  964. ' *
  965. '
  966.       GOSUB 25000
  967.       CALL OPENMSG
  968.       RETURN
  969. '
  970. ' *
  971. ' *  LOCK MESSAGE FILE                                                        *
  972. ' *
  973. '
  974. 22000 IF MESSAGE.FILE.LOCK = TRUE THEN _
  975.          RETURN
  976.       MESSAGE.FILE.LOCK = TRUE
  977.       MID$(LOCK.STATUS$,1,2) = "LM"
  978.       SUBROUTINE.PARAMETER = 2
  979.       CALL LINE25
  980.       LOCK.FILE.NAME$ = ACTIVE.MESSAGE.FILE$
  981.       ON NETWORK.TYPE GOTO 22100,22200,22300,22400,22500,29700
  982.       RETURN
  983. '
  984. ' *
  985. ' *  LOCK MESSAGE FILE (MULTI-LINK)                                           *
  986. ' *
  987. '
  988. 22100 AX = &H0
  989.       BX = &H1
  990.       IF MULTI.LINK.PRESENT > 0 THEN _
  991.          CALL RBBSML(AX,BX)
  992.       RETURN
  993. '
  994. ' *
  995. ' *  LOCK MESSAGE FILE (OMNINET)                                              *
  996. ' *
  997. '
  998. 22200 CALL BRKFNAME (ACTIVE.MESSAGE.FILE$,DRV$,FPREFIX$,EXT$,FALSE)  ' KG121102
  999.       CC$ = CHR$(1) + _
  1000.             LEFT$(FPREFIX$ + SPACE$(8),8)                            ' KG121102
  1001.       GOSUB 28000
  1002.       IF CT = 0 THEN _
  1003.          RETURN
  1004.       CALL DELAYIT (1)
  1005.       GOTO 22200
  1006. '
  1007. ' *
  1008. ' *  LOCK MESSAGE FILE (ORCHID PC-NET)                                        *
  1009. ' *  LOCK USER FILE (ORCHID PC-NET)                                           *
  1010. ' *  LOCK UPLOAD DIRECTORY OR COMMENTS BASED ON EN$ (ORCHID PC-NET)           *
  1011. ' *
  1012. '
  1013. 22300 GOSUB 28100
  1014.       CALL LPLKIT(LOCK.DRIVE,LOCK.FILE.NAME$,A)
  1015.       RETURN
  1016. '
  1017. ' *
  1018. ' *  LOCK SYSTEM (DESQview)                                                   *
  1019. ' *
  1020. '
  1021. 22400 CALL DVLOCK("MESSAGE")                                         ' JM102401
  1022.       RETURN
  1023. '
  1024. ' *
  1025. ' *  LOCK MESSAGE FILE (10 NET)                                               *
  1026. ' *  LOCK USER FILE (10 NET)                                                  *
  1027. ' *  LOCK UPLOAD DIRECTORY OR COMMENTS BASED ON EN$ (10 NET)                  *
  1028. ' *
  1029. '
  1030. 22500 GOSUB 28100
  1031.       CALL LPLK10(LOCK.DRIVE,LOCK.FILE.NAME$,A)
  1032.       RETURN
  1033. '
  1034. ' *
  1035. ' *  UNLOCK MESSAGE FILE                                                      *
  1036. ' *
  1037. '
  1038. 25000 IF NOT MESSAGE.FILE.LOCK THEN _
  1039.          RETURN
  1040.       MESSAGE.FILE.LOCK = FALSE
  1041.       MID$(LOCK.STATUS$,1,2) = "UM"
  1042.       SUBROUTINE.PARAMETER = 2
  1043.       CALL LINE25
  1044.       LOCK.FILE.NAME$ = ACTIVE.MESSAGE.FILE$
  1045.       ON NETWORK.TYPE GOTO 25100,25200,25300,25400,25500,29800
  1046.       RETURN
  1047. '
  1048. ' *
  1049. ' *  UNLOCK MESSAGE FILE (MULTI-LINK)                                         *
  1050. ' *
  1051. '
  1052. 25100 AX = &H100
  1053.       BX = &H1
  1054.       IF MULTI.LINK.PRESENT > 0 THEN _
  1055.          CALL RBBSML(AX,BX)
  1056.       RETURN
  1057. '
  1058. ' *
  1059. ' *  UNLOCK MESSAGE FILE (OMNINET)                                            *
  1060. ' *
  1061. '
  1062. 25200 CALL BRKFNAME (ACTIVE.MESSAGE.FILE$,DRV$,FPREFIX$,EXT$,FALSE)  ' KG121102
  1063.       CC$ = CHR$(17) + _
  1064.             LEFT$(FPREFIX$ + SPACE$(8),8)                            ' KG121102
  1065.       GOSUB 28000
  1066.       IF CT = 128 THEN _
  1067.          RETURN
  1068.       CALL DELAYIT (1)
  1069.       GOTO 25200
  1070. '
  1071. ' *
  1072. ' *  UNLOCK MESSAGE FILE (ORCHID PC-NET)                                      *
  1073. ' *  UNLOCK USER FILE (ORCHID PC-NET)                                         *
  1074. ' *  UNLOCK UPLOAD DIRECTORY OR COMMENTS BASED ON EN$ (ORCHID PC-NET)         *
  1075. ' *
  1076. '
  1077. 25300 GOSUB 28100
  1078.       CALL UNLOKIT(LOCK.DRIVE,LOCK.FILE.NAME$,A)
  1079.       RETURN
  1080. '
  1081. ' *
  1082. ' *  UNLOCK MESSAGE FILE (DESQVIEW)                                         *
  1083. ' *
  1084. '
  1085. 25400 CALL DVUNLOCK("MESSAGE")                                       ' JM102401
  1086.       RETURN
  1087. '
  1088. ' *
  1089. ' *  UNLOCK MESSAGE FILE (10 NET)                                             *
  1090. ' *  UNLOCK USER FILE (10 NET)                                                *
  1091. ' *  UNLOCK UPLOAD DIRECTORY OR COMMENTS BASED ON EN$ (10 NET)                *
  1092. ' *
  1093. '
  1094. 25500 GOSUB 28100
  1095.       CALL UNLOK10(LOCK.DRIVE,LOCK.FILE.NAME$,A)
  1096.       RETURN
  1097.  
  1098. '
  1099. ' *
  1100. ' *  LOCK USER FILE                                                           *
  1101. ' *
  1102. '
  1103. 26000 IF USER.FILE.LOCK = TRUE THEN _
  1104.          RETURN
  1105.       USER.FILE.LOCK = TRUE
  1106.       MID$(LOCK.STATUS$,4,2) = "LU"
  1107.       SUBROUTINE.PARAMETER = 2
  1108.       CALL LINE25
  1109.       LOCK.FILE.NAME$ = ACTIVE.USER.FILE$
  1110.       ON NETWORK.TYPE GOTO 26100,26200,22300,26300,22500,29720       ' JM102401
  1111.       RETURN
  1112. '
  1113. ' *
  1114. ' *  LOCK USER FILE (MULTI-LINK)                                              *
  1115. ' *
  1116. '
  1117. 26100 AX = &H0
  1118.       BX = &H2
  1119.       IF MULTI.LINK.PRESENT > 0 THEN _
  1120.          CALL RBBSML(AX,BX)
  1121.       RETURN
  1122. '
  1123. ' *
  1124. ' *  LOCK USER FILE (OMNINET)                                                 *
  1125. ' *
  1126. '
  1127. 26200 CALL BRKFNAME (ACTIVE.USER.FILE$,DRV$,FPREFIX$,EXT$,FALSE)     ' KG121102
  1128.       CC$ = CHR$(1) + _
  1129.             LEFT$(FPREFIX$ + SPACE$(8),8)                            ' KG121102
  1130.       GOSUB 28000
  1131.       IF CT = 0 THEN _
  1132.          RETURN
  1133.       CALL DELAYIT (1)
  1134.       GOTO 26200
  1135. '
  1136. ' *
  1137. ' *  LOCK USER FILE (DESQVIEW)                                                *
  1138. ' *
  1139. '
  1140. 26300 CALL DVLOCK("USER")                                            ' JM102401
  1141.       RETURN                                                         ' JM102401
  1142. '
  1143. ' *
  1144. ' *  LOCK 4 RECORD BLOCK IN USER FILE                                         *
  1145. ' *
  1146. '
  1147. 26500 IF USER.BLOCK.LOCK = TRUE THEN _
  1148.          RETURN
  1149.       USER.BLOCK.LOCK = TRUE
  1150.       BLK = (USER.FILE.INDEX / 4) + .26
  1151.       MID$(LOCK.STATUS$,7,2) = "LB"
  1152.       SUBROUTINE.PARAMETER = 2
  1153.       CALL LINE25
  1154.       ON NETWORK.TYPE GOTO 26600,26700,26800,26750,26900,29730       ' JM102401
  1155.       RETURN
  1156. '
  1157. ' *
  1158. ' *  LOCK 4 RECORD BLOCK IN USER FILE (MULTI-LINK)                            *
  1159. ' *
  1160. '
  1161. 26600 AX = &H0
  1162.       BX = BLK + 10
  1163.       IF MULTI.LINK.PRESENT > 0 THEN _
  1164.          CALL RBBSML(AX,BX)
  1165.       RETURN
  1166. '
  1167. ' *
  1168. ' *  LOCK 4 RECORD BLOCK IN USER FILE (OMNINET)                               *
  1169. ' *
  1170. '
  1171. 26700 CC$ = CHR$(1) + _
  1172.             "BLK" + _
  1173.             RIGHT$("0000" + MID$(STR$(BLK),2),5)
  1174.       GOSUB 28000
  1175.       IF CT = 0 THEN _
  1176.          RETURN
  1177.       CALL DELAYIT (1)
  1178.       GOTO 26700
  1179. '
  1180. ' *
  1181. ' *  LOCK 4 RECORD BLOCK IN USER FILE (DESKVIEW)                              *
  1182. ' *
  1183. '
  1184. 26750 CALL DVLOCK("BLK" + RIGHT$("0000" + MID$(STR$(BLK),2),5))      ' JM102401
  1185.       RETURN                                                         ' JM102401
  1186. '
  1187. ' *
  1188. ' *  LOCK 4 RECORD BLOCK IN USER FILE (ORCHID PC-NET)                         *
  1189. ' *
  1190. '
  1191. 26800 LOCK.FILE.NAME$ = LEFT$(ACTIVE.USER.FILE$,2) + _
  1192.                         "BLK" + _
  1193.                         RIGHT$("0000" + MID$(STR$(BLK),2),5)
  1194.       GOTO 22300
  1195. '
  1196. ' *
  1197. ' *  LOCK 4 RECORD BLOCK IN USER FILE (10 NET)                                *
  1198. ' *
  1199. '
  1200. 26900 LOCK.FILE.NAME$ = LEFT$(ACTIVE.USER.FILE$,2) + _
  1201.                         "BLK" + _
  1202.                         RIGHT$("0000" + MID$(STR$(BLK),2),5)
  1203.       GOTO 22500
  1204. '
  1205. ' *
  1206. ' *  UNLOCK USER FILE                                                         *
  1207. ' *
  1208. '
  1209. 27000 IF NOT USER.FILE.LOCK THEN _
  1210.          RETURN
  1211.       USER.FILE.LOCK = FALSE
  1212.       MID$(LOCK.STATUS$,4,2) = "UU"
  1213.       SUBROUTINE.PARAMETER = 2
  1214.       CALL LINE25
  1215.       LOCK.FILE.NAME$ = ACTIVE.USER.FILE$
  1216.       ON NETWORK.TYPE GOTO 27100,27200,25300,27300,25500,29820       ' JM102401
  1217.       RETURN
  1218. '
  1219. ' *
  1220. ' *  UNLOCK USER FILE (MULTI-LINK)                                            *
  1221. ' *
  1222. '
  1223. 27100 AX = &H100
  1224.       BX = &H2
  1225.       IF MULTI.LINK.PRESENT > 0 THEN _
  1226.          CALL RBBSML(AX,BX)
  1227.       RETURN
  1228. '
  1229. ' *
  1230. ' *  UNLOCK USER FILE (OMNINET)                                               *
  1231. ' *
  1232. '
  1233. 27200 CALL BRKFNAME (ACTIVE.USER.FILE$,DRV$,FPREFIX$,EXT$,FALSE)     ' KG121102
  1234.       CC$ = CHR$(17) + _
  1235.             LEFT$(FPREFIX$ + SPACE$(8),8)                            ' KG121102
  1236.       GOSUB 28000
  1237.       IF CT = 128 THEN _
  1238.          RETURN
  1239.       CALL DELAYIT (1)
  1240.       GOTO 27200
  1241. '
  1242. ' *
  1243. ' *  UNLOCK USER FILE (DESQVIEW)                                              *
  1244. ' *
  1245. '
  1246. 27300 CALL DVUNLOCK("USER")                                          ' JM102401
  1247.       RETURN                                                         ' JM102401
  1248. '
  1249. ' *
  1250. ' *  UNLOCK 4 RECORD BLOCK IN USER FILE                                       *
  1251. ' *
  1252. '
  1253. 27500 IF NOT USER.BLOCK.LOCK THEN _
  1254.          RETURN
  1255.       USER.BLOCK.LOCK = FALSE
  1256.       BLK = (USER.FILE.INDEX / 4) + .26
  1257.       MID$(LOCK.STATUS$,7,2) = "UB"
  1258.       SUBROUTINE.PARAMETER = 2
  1259.       CALL LINE25
  1260.       ON NETWORK.TYPE GOTO 27600,27700,27800,27750,27900,29830       ' JM102401
  1261.       RETURN
  1262. '
  1263. ' *
  1264. ' *  UNLOCK 4 RECORD BLOCK IN USER FILE (MULTI-LINK)                          *
  1265. ' *
  1266. '
  1267. 27600 AX = &H100
  1268.       BX = BLK + 10
  1269.       IF MULTI.LINK.PRESENT > 0 THEN _
  1270.          CALL RBBSML(AX,BX)
  1271.       RETURN
  1272. '
  1273. ' *
  1274. ' *  UNLOCK 4 RECORD BLOCK IN USER FILE (OMNINET)                             *
  1275. ' *
  1276. '
  1277. 27700 CC$ = CHR$(17) + _
  1278.             "BLK" + _
  1279.             RIGHT$("0000" + MID$(STR$(BLK),2),5)
  1280.       GOSUB 28000
  1281.       IF CT = 128 THEN _
  1282.          RETURN
  1283.       CALL DELAYIT (1)
  1284.       GOTO 27700
  1285. '
  1286. ' *
  1287. ' *  UNLOCK 4 RECORD BLOCK IN USER FILE (DESQVIEW)                            *
  1288. ' *
  1289. '
  1290. 27750 CALL DVUNLOCK("BLK" + RIGHT$("0000" + MID$(STR$(BLK),2),5))    ' JM102401
  1291.       RETURN                                                         ' JM102401
  1292. '
  1293. ' *
  1294. ' *  UNLOCK 4 RECORD BLOCK IN USER FILE (ORCHID PC-NET)                       *
  1295. ' *
  1296. '
  1297. 27800 LOCK.FILE.NAME$ = LEFT$(ACTIVE.USER.FILE$,2) + _
  1298.                         "BLK" + _
  1299.                         RIGHT$("0000" + MID$(STR$(BLK),2),5)
  1300.       GOTO 25300
  1301. '
  1302. ' *
  1303. ' *  UNLOCK 4 RECORD BLOCK IN USER FILE (ORCHID PC-NET)                       *
  1304. ' *
  1305. '
  1306. 27900 LOCK.FILE.NAME$ = LEFT$(ACTIVE.USER.FILE$,2) + _
  1307.                         "BLK" + _
  1308.                         RIGHT$("0000" + MID$(STR$(BLK),2),5)
  1309.       GOTO 25500
  1310. '
  1311. ' *
  1312. ' *  CORVUS OMNINET INTERFACE                                                 *
  1313. ' *
  1314. '
  1315. 28000 CC$ = LINE.FEED$ + _
  1316.             CHR$(0) + _
  1317.             CHR$(11) + _
  1318.             CC$
  1319.       CALL CDSEND(CC$)
  1320.       CALL CDRECV(CN$)
  1321.       CT = ASC(MID$(CN$,3,1))
  1322.       IF CT => 128 THEN _
  1323.          CALL LPRNT("CORVUS LOCK FAIL",1) : _
  1324.          SUBROUTINE.PARAMETER = -1
  1325. 28010 CT = ASC(MID$(CN$,4,1))
  1326.       IF CT => 129 THEN _
  1327.          CALL LPRNT("CORVUS FULL",1) : _
  1328.          SUBROUTINE.PARAMETER = -1
  1329.       RETURN
  1330. '
  1331. ' *
  1332. ' *  ORCHID PC-NET & 10 NET INTERFACE                                         *
  1333. ' *
  1334. '
  1335. 28100 CALL ALLCAPS (LOCK.FILE.NAME$)
  1336.       LOCK.DRIVE = ASC(LEFT$(LOCK.FILE.NAME$,1)) - ASC("A")
  1337.       LOCK.FILE.NAME$ = LOCK.FILE.NAME$ + _
  1338.                         STRING$(32 - LEN(LOCK.FILE.NAME$),0)
  1339.       A = 0
  1340.       RETURN
  1341. '
  1342. ' *
  1343. ' *  LOCK UPLOAD DIRECTORY OR COMMENTS BASED ON EN$                           *
  1344. ' *
  1345. '
  1346. 29000 IF LOCKED.EN$ = EN$ THEN _
  1347.          RETURN
  1348.       LOCKED.EN$ = EN$
  1349.       MID$(LOCK.STATUS$,10,2) = "LD"
  1350.       SUBROUTINE.PARAMETER = 2
  1351.       CALL LINE25
  1352.       LOCK.FILE.NAME$ = EN$
  1353.       ON NETWORK.TYPE GOTO 29100,29010,22300,29300,22500,29710       ' JM102401
  1354. 29010 RETURN
  1355. '
  1356. ' *
  1357. ' *  LOCK UPLOAD DIRECTORY OR COMMENTS BASED ON EN$ (MULTI-LINK)              *
  1358. ' *
  1359. '
  1360. 29100 AX = &H0
  1361.       BX = &H3
  1362.       IF MULTI.LINK.PRESENT > 0 THEN _
  1363.          CALL RBBSML(AX,BX)
  1364.       RETURN
  1365. '
  1366. ' *
  1367. ' *  LOCK UPLOAD DIRECTORY AND COMMENTS (DESQVIEW)                            *
  1368. ' *
  1369. '
  1370. 29300 CALL DVLOCK("MISC")                                            ' JM102401
  1371.       RETURN                                                         ' JM102401
  1372. '
  1373. ' *
  1374. ' *  UNLOCK UPLOAD DIRECTORY OR COMMENTS BASED ON EN$                         *
  1375. ' *
  1376. '
  1377. 29500 IF LOCKED.EN$ <> EN$ THEN _
  1378.          RETURN
  1379.       LOCKED.EN$ = ""
  1380.       MID$(LOCK.STATUS$,10,2) = "UD"
  1381.       SUBROUTINE.PARAMETER = 2
  1382.       CALL LINE25
  1383.       LOCK.FILE.NAME$ = EN$
  1384.       ON NETWORK.TYPE GOTO 29600,29510,25300,29650,25500,29810       ' JM102401
  1385. 29510 RETURN
  1386. '
  1387. ' *
  1388. ' *  UNLOCK UPLOAD DIRECTORY OR COMMENTS BASED ON EN$ (MULTI-LINK)            *
  1389. ' *
  1390. '
  1391. 29600 AX = &H100
  1392.       BX = &H3
  1393.       IF MULTI.LINK.PRESENT > 0 THEN _
  1394.          CALL RBBSML(AX,BX)
  1395.       EXIT SUB
  1396. '
  1397. ' *
  1398. ' *  UNLOCK UPLOAD DIRECTORY AND COMMENTS (DESQVIEW)                            *
  1399. ' *
  1400. '
  1401. 29650 CALL DVUNLOCK("MISC")                                          ' JM102401
  1402.       RETURN                                                         ' JM102401
  1403. '
  1404. ' *
  1405. ' *  NETBIOS SEMAPHORE LOCK MECHANISM                                         *
  1406. ' *     Only the USERS file is actually locked.  All other files are locked   *
  1407. ' *     by means of the semaphore file IBMFLAGS.  Each IBMFLAGS record is a   *
  1408. ' *     file semaphore as follows:                                            *
  1409. ' *        RECORD 1 = MESSAGES file lock status                               *
  1410. ' *        RECORD 2 = Comments/Upload dir locked                              *
  1411. ' *        RECORD 3 = entire USERS file lock                                  *
  1412. ' *
  1413. '
  1414. ' * Lock MESSAGES
  1415. 29700 CALL NETBIOS (1,6,1)
  1416.       RETURN
  1417.  
  1418. ' * Lock Comments/Upload dir
  1419. 29710 CALL NETBIOS (1,6,2)
  1420.       RETURN
  1421.  
  1422. ' * Lock USERS file
  1423. 29720 CALL NETBIOS (1,6,3)
  1424.       RETURN
  1425.  
  1426. ' * Lock single USERS record
  1427. 29730 CALL NETBIOS (1,6,3)                                           ' JM110802
  1428.       RETURN
  1429.  
  1430. ' * UNLOCK MESSAGES
  1431. 29800 CALL NETBIOS (0,6,1)
  1432.       RETURN
  1433.  
  1434. ' * UNLOCK Comments/Upload dir
  1435. 29810 CALL NETBIOS (0,6,2)
  1436.       RETURN
  1437.  
  1438. ' * UNLOCK USERS file
  1439. 29820 CALL NETBIOS (0,6,3)
  1440.       RETURN
  1441.  
  1442. ' * UNLOCK single USERS record
  1443. 29830 CALL NETBIOS (0,6,3)                                           ' JM110802
  1444.       RETURN
  1445.       END SUB
  1446. ' $SUBTITLE: 'INITIBM - subroutine to create/open NETBIOS semaphore file'
  1447. ' $PAGE
  1448. '
  1449. '  SUBROUTINE NAME    -- INITIBM   (Written by Doug Azzarito)
  1450. '
  1451. '  INPUT PARAMETERS   -- NONE
  1452. '
  1453. '  OUTPUT PARAMETERS  -- SUBROUTINE.PARAMETER = -1   ABORT RBBS
  1454. '
  1455. '  SUBROUTINE PURPOSE -- OPEN SEMAPHORE FILE "IBMFLAGS" ON DEFAULT DRIVE
  1456. '                        AS FILE #6
  1457. '                        IF FILE DOES NOT EXIST, IT IS CREATED.
  1458. '
  1459.       SUB INITIBM STATIC
  1460. '
  1461. ' *
  1462. ' *  SEE IF FILE EXISTS                                                       *
  1463. ' *
  1464. '
  1465. 30000 SHARE.IT = TRUE
  1466.       FOR I = LEN(MAIN.MESSAGE.FILE$) TO 0 STEP -1
  1467.          IF I = 0 THEN _
  1468.             GOTO 30010
  1469.          IF MID$(MAIN.MESSAGE.FILE$,I,1) = ":" OR _
  1470.             MID$(MAIN.MESSAGE.FILE$,I,1) = "\" THEN _
  1471.             GOTO 30010
  1472.       NEXT
  1473. 30010 IBM.FLAG.FILE$ = LEFT$(MAIN.MESSAGE.FILE$,I) + _
  1474.                        "IBMFLAGS"
  1475.       CALL FINDIT (IBM.FLAG.FILE$)
  1476.       CLOSE 2
  1477.       IF OK THEN _
  1478.          GOTO 30020
  1479. '
  1480. ' *
  1481. ' *  CREATE A NEW FILE, EACH RECORD IS A SEMAPHORE                            *
  1482. ' *
  1483. '
  1484.       OPEN IBM.FLAG.FILE$ ACCESS WRITE AS #6 LEN=2
  1485.       FIELD 6, 2 AS LOCKBUF$
  1486.       LSET LOCKBUF$ = MKI$(0)
  1487.       FOR I = 1 TO 3
  1488.          PUT 6
  1489.       NEXT
  1490.       CLOSE #6
  1491. 30020 OPEN IBM.FLAG.FILE$ ACCESS READ WRITE SHARED AS #6 LEN=2
  1492.       END SUB
  1493. ' $SUBTITLE: 'OPENMSG - open the MESSAGES file'
  1494. ' $PAGE
  1495. '
  1496. '  SUBROUTINE NAME    -- OPENMSG
  1497. '
  1498. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  1499. '                         ACTIVE.MESSAGE.FILE$
  1500. '                         SHARE.IT
  1501. '
  1502. '  OUTPUT PARAMETERS  --  MESSAGE.RECORD$
  1503. '
  1504.       SUB OPENMSG STATIC
  1505. '
  1506. ' *
  1507. ' *  OPEN AND DEFINE MESSAGE FILE                                             *
  1508. ' *
  1509. '
  1510. 30500 CLOSE 1
  1511.       IF SHARE.IT THEN _
  1512.          OPEN ACTIVE.MESSAGE.FILE$ ACCESS READ WRITE SHARED AS #1 _
  1513.       ELSE OPEN "R",1,ACTIVE.MESSAGE.FILE$
  1514.       FIELD 1,128 AS MESSAGE.RECORD$
  1515.       END SUB
  1516. ' $SUBTITLE: 'FINDFUNC - subroutine to handle local keyboard functions'
  1517. ' $PAGE
  1518. '
  1519. '  SUBROUTINE NAME    -- FINDFUNC
  1520. '
  1521. '  INPUT PARAMETERS   --
  1522. '               PARAMETER                 MEANING
  1523. '             ACTIVE.MENU$              INDICATOR OF ACTIVE MENU
  1524. '             ADJUSTED.SECURITY         SWITCH INDICATING TEMP. SECURITY CHANGE
  1525. '             AUTODOWNLOAD.DESIRED      USER'S PREFERENCE FOR AUTODOWNLOADING
  1526. '             CALLERS.FILE$             NAME OF CALLERS FILE
  1527. '             CHAT.AVAILABLE            TOGGLE INDICATING IF SYSOP WILL CHAT
  1528. '             CHECK.BULLETIN.LOGON      USER'S PREFERENCE FOR BULLETIN CHECK
  1529. '             CONFERENCE.MODE           INDICATOR THAT USER IS IN A CONFERENCE
  1530. '             CURSOR.LINE               LINE THAT THE CURSOR IS AT
  1531. '             CURSOR.ROW                ROW THAT THE CURSOR IS AT
  1532. '             DISK.FOR.DOS$             DISK TO LOAD COMMAND.COM FROM
  1533. '             DISKFULL.GO.OFFLINE       INDICATOR OF WHAT TO DO WHEN DISK FULL
  1534. '             EXIT.TO.DOORS             FLAG INDICATING EXITING TO DOORS
  1535. '             EXPERT.USER               FLAG FOR EXPERT/NOVICE USER MODE
  1536. '             FIRST.NAME$               LOGGED ON USER'S FIRST NAME
  1537. '             F1.KEY                    FUNCTION KEY ONE VALUE
  1538. '             F10.KEY                   FUNCTION KEY TEN VALUE
  1539. '             GR                        GRAPHICS PREFERENCE OF USER
  1540. '             LINE.FEEDS                SWTICH FOR USER'S LINE FEED PREFERENCE
  1541. '             LOCAL.USER                FLAG INDICATING USER IS LOCAL
  1542. '             MINIMUM.LOGON.SECURITY    MINIMUM SECURITY TO LOGON
  1543. '             MODEM.GO.OFFHOOK.COMMAND$ COMMAND TO TAKE MODEM OFF-HOOK
  1544. '             MODEM.INIT.BAUD$          BAUD TO INITIALIZE MODEM AT
  1545. '             NODE.ID$                  NODE IDENTIFIER
  1546. '             NODE.RECORD.INDEX         NODE RECORD INDEX FOR THIS NODE
  1547. '             NULLS                     SWITCH FOR USER'S PREFERENCE FOR NULLS
  1548. '             PRINTER                   TOGGLE INDICATING PRINTER IS AVAILABLE
  1549. '             PROMPT.BELL               USER'S PREFERENCE FOR BELLS ON PROMPTS
  1550. '             SECONDS.PER.SESSION      TIME LEFT IN CURRENT USER SESSION 'DA011205
  1551. '             SKIP.FILES.LOGON          USER'S LOGON NOTIFICIATION PREFERENCE
  1552. '             SNOOP                     TOGGLE INDICATING SNOOP STATUS
  1553. '             SUBROUTINE.PARAMETER      -8  = SYSOP'S OPTION 6 REMOTELY
  1554. '                                       -9  = GOT TO DOS
  1555. '                                       -10 = SYSOP GET'S SYSTEM NEXT
  1556. '             SYSOP                     INDICATOR THAT USER IS SYSOP
  1557. '             SYSOP.ANNOY               TOGGLE INDICATING SYSOP IS AVAILABLE
  1558. '             SYSOP.NEXT                TOGGLE SO SYSOP GETS SYSTEM NEXT
  1559. '             UPPER.CASE                USER'S PREFERENCE FOR UPPER/LOWER CASE
  1560. '             USER.FILE.INDEX           INDEX INTO THE USER FILE FOR CALLER
  1561. '             USER.SECURITY.LEVEL       USER'S SECURITY LEVEL
  1562. '             USERT.TRANSFER.DEFAULT    USER'S FILE TRANSFER DEFAULT PREFERENCE
  1563. '
  1564. '  OUTPUT PARAMETERS  --
  1565. '             ADJUSTED.SECURITY        SWITCH INDICATING TEMP. SECURITY CHANGE
  1566. '             CHAT.AVAILABLE           TOGGLE INDICATING IF SYSOP WILL CHAT
  1567. '             FUNCTION.KEY             VALUE 1 TO 10 CORRESPONDING TO
  1568. '                                      THE FUNCTION KEY THAT WAS PRESSED
  1569. '             KEY.PRESSED$             CHARACTER STRING GENERATED BY KEY
  1570. '             PRINTER                  TOGGEL INDICATING PRINTER IS AVAILABLE
  1571. '             SNOOP                    TOGGLE INDICATING SNOOP STATUS
  1572. '             SYSOP                    INDICATOR THAT USER IS SYSOP
  1573. '             SYSOP.ANNOY              TOGGLE INDICATING SYSOP IS AVAILABLE
  1574. '             SYSOP.NEXT               TOGGLE SO SYSOP GETS SYSTEM NEXT
  1575. '             SUBROUTINE.PARAMETER     -1 CARRIER LOST
  1576. '                                      -2 CHAT MODE ACTIVATED
  1577. '                                      -3 FORCE CALLER ON-LINE
  1578. '                                      -4 EXIT TO SYSTEM IMMEDIATELY
  1579. '                                      -5 EXIT TO SYSTEM AFTER MULTI-LINK CALL
  1580. '                                      -6 TELL USER ACCESS IS DENIED
  1581. '                                      -7 UPDATE CALLERS FILE AND DENY ACCESS
  1582. '             USER.SECURITY.LEVEL      USER'S SECURITY LEVEL
  1583. '
  1584. '  SUBROUTINE PURPOSE -- TO DETERMINE IF A FUNCTION HAS BEEN PRESSED ON
  1585. '                        THE PC'S KEYBOARD THAT IS RUNNING RBBS-PC.
  1586. '
  1587.       SUB FINDFUNC STATIC
  1588.       LOOKUP = SUBROUTINE.PARAMETER
  1589.       IF SUBROUTINE.PARAMETER < -1 THEN _
  1590.          SUBROUTINE.PARAMETER = 0 : _
  1591.          IF LOOKUP = - 8 THEN _
  1592.             GOTO 33070 _
  1593.          ELSE IF LOOKUP = - 9 THEN _
  1594.                  GOTO 31000 _
  1595.               ELSE IF LOOKUP = - 10 THEN _
  1596.                       GOTO 33090
  1597. '
  1598. ' *
  1599. ' *  TEST FOR FUNCTION KEY PRESSED                                            *
  1600. ' *
  1601. '
  1602. 30600 IF KEYBOARD.STACK$ = "" THEN _
  1603.          KEY.PRESSED$ = INKEY$ _
  1604.       ELSE KEY.PRESSED$ = KEYBOARD.STACK$ : _
  1605.            KEYBOARD.STACK$ = ""
  1606.       FUNCTION.KEY = 0
  1607.       IF LEN(KEY.PRESSED$) <> 2 THEN _
  1608.          GOTO 33970
  1609.       KEY.PRESSED = ASC(RIGHT$(KEY.PRESSED$,1))
  1610.       IF LOCAL.USER.MODE AND NOT SYSOP THEN _        ' PE 11/04/88
  1611.          KEY.PRESSED$ = "" : _
  1612.          GOTO 33970
  1613.       IF KEY.PRESSED => F1.KEY AND _
  1614.          KEY.PRESSED <= F10.KEY THEN _
  1615.              FUNCTION.KEY = KEY.PRESSED - 58 : _
  1616.              GOTO 30610
  1617.       IF KEY.PRESSED = 79 THEN _     'End
  1618.          FUNCTION.KEY = 11
  1619.       IF KEY.PRESSED = 73 THEN _     'PgUp
  1620.          FUNCTION.KEY = 12
  1621.       IF KEY.PRESSED = 72 THEN _     'up arrow
  1622.          FUNCTION.KEY = 13
  1623.       IF KEY.PRESSED = 80 THEN _     'Down arrow
  1624.          FUNCTION.KEY = 14
  1625.       IF KEY.PRESSED = 81 THEN _     'PgDn
  1626.          FUNCTION.KEY = 15
  1627.       IF KEY.PRESSED = 75 THEN _     'left arrow
  1628.          FUNCTION.KEY = 16
  1629.       IF KEY.PRESSED = 77 THEN _     'Right arrow
  1630.          FUNCTION.KEY = 17
  1631.       IF KEY.PRESSED = 141 THEN _    'CTRL-up arrow
  1632.          FUNCTION.KEY = 18
  1633.       IF KEY.PRESSED = 132 THEN _    'CTRL-PgUp (same as CTRL-UP)
  1634.          FUNCTION.KEY = 18
  1635.       IF KEY.PRESSED = 145 THEN _    'CTRL-down arrow
  1636.          FUNCTION.KEY = 19
  1637.       IF KEY.PRESSED = 118 THEN _    'CTRL-PgDn (same as CTRL-DOWN)
  1638.          FUNCTION.KEY = 19
  1639.       IF KEY.PRESSED = 115 THEN _    'CTRL-left arrow
  1640.          FUNCTION.KEY = 20
  1641.       IF KEY.PRESSED = 116 THEN _    'CTRL-right arrow
  1642.          FUNCTION.KEY = 21
  1643. 30610 KEY.PRESSED$ = ""
  1644.       IF FUNCTION.KEY < 1 OR FUNCTION.KEY > 21 THEN _
  1645.          GOTO 33970
  1646.       IF FUNCTION.KEY < 10 AND (FUNCTION.KEY <> 8) THEN _
  1647.          GOTO 30620
  1648.       IF TOGGLE.ONLY THEN _
  1649.          SUBROUTINE.PARAMETER = 1 : _
  1650.          GOTO 33970
  1651. 30620 ON FUNCTION.KEY GOTO  31000, _            '  1 =  F1
  1652.                             32000, _            '  2 =  F2
  1653.                             33000, _            '  3 =  F3
  1654.                             33040, _            '  4 =  F4
  1655.                             33060, _            '  5 =  F5
  1656.                             33070, _            '  6 =  F6
  1657.                             33090, _            '  7 =  F7
  1658.                             33110, _            '  8 =  F8
  1659.                             33130, _            '  9 =  F9
  1660.                             33150, _            ' 10 = F10
  1661.                             31398, _            ' 11 = END KEY
  1662.                             33200, _            ' 12 = PGUP
  1663.                             33170, _            ' 13 = UP ARROW
  1664.                             33180, _            ' 14 = DOWN ARROW
  1665.                             33220, _            ' 15 = PGDN
  1666.                             33240, _            ' 16 = LEFT ARROW
  1667.                             33250, _            ' 17 = RIGHT ARROW
  1668.                             33170, _            ' 18 = CTRL-UP ARROW
  1669.                             33180, _            ' 19 = CTRL-DOWN
  1670.                             33245, _            ' 20 = CTRL-LEFT
  1671.                             33255               ' 21 = CTRL-RIGHT
  1672. '
  1673. ' *
  1674. ' * F1 - COMMAND FROM LOCAL KEYBOARD (IMMEDIATE EXIT TO DOS)                  *
  1675. ' *
  1676. '
  1677. 31000 SUBROUTINE.PARAMETER = -10
  1678.       CALL CARRIER
  1679.       IF SUBROUTINE.PARAMETER = 0 THEN _
  1680.          GOTO 33970
  1681.       CALL BRKFNAME(CALLERS.FILE$,X$,Y$,Z$,TRUE)
  1682.       FILE.NAME$ = X$ + "RBBS" + NODE.FILE.ID$ + "F1.DEF"
  1683.       CLOSE 2
  1684.       CALL OPENOUTW (FILE.NAME$)                                     ' LP102201
  1685.       PRINT #2,MID$(FILE.NAME$,3,7)
  1686.       IF EXIT.TO.DOORS THEN _
  1687.          SUBROUTINE.PARAMETER = -4 : _
  1688.          GOTO 33970
  1689.       CALL OPENCOM(MODEM.INIT.BAUD$,",N,8,1")
  1690.       CALL MODEMPUT (MODEM.GO.OFFHOOK.COMMAND$)
  1691.       CALL DELAYIT (2)
  1692.       SUBROUTINE.PARAMETER = -5
  1693.       GOTO 33970
  1694. '
  1695. ' *
  1696. ' *  END KEY - FORCE CURRENT USER OFF AND LOCK THEM OUT                       *
  1697. ' *
  1698. '
  1699. 31398 IF NOT LOCAL.USER THEN _
  1700.          CALL CARRIER : _
  1701.          IF SUBROUTINE.PARAMETER = -1 THEN _
  1702.             GOTO 33970
  1703.       FUNCTION.KEY = 0
  1704.       IF INSTR("MUF",ACTIVE.MENU$) > 0 THEN _
  1705.          GOTO 31399
  1706.       CURSOR.LINE = CSRLIN
  1707.       CURSOR.ROW = POS(0)
  1708.       LOCATE 25,1
  1709.       D$ = SPACE$(79)
  1710.       GOSUB 33210
  1711.       LOCATE 25,1
  1712.       D$ ="Cannot FORCE OFF until user reaches MAIN menu"
  1713.       GOSUB 33210
  1714.       CALL DELAYIT (1)
  1715.       LOCATE CURSOR.LINE,CURSOR.ROW
  1716.       SUBROUTINE.PARAMETER = 1
  1717.       CALL LINE25
  1718.       GOTO 33970
  1719. 31399 CALL QTPUT(FIRST.NAME$ + ", goodbye and don't call back",1)
  1720.       IF USER.FILE.INDEX < 1 THEN _
  1721.          SUBROUTINE.PARAMETER = -6 : _
  1722.          GOTO 33970
  1723.       USER.SECURITY.LEVEL = MINIMUM.LOGON.SECURITY - 1
  1724.       CALL DENYACCESS
  1725.       SUBROUTINE.PARAMETER = -7
  1726.       GOTO 33970
  1727. '
  1728. ' *
  1729. ' * F2 - COMMAND FROM LOCAL KEYBOARD (SYSOP EXIT TO DOS AND RETURN)           *
  1730. ' *
  1731. '
  1732.  
  1733. 32000 IF NOT LOCAL.USER THEN _
  1734.          CALL SKIPLINE (1) : _
  1735.          CALL QTPUT("Sysop exiting to DOS. Please wait...",1) : _
  1736.          FUNCTION.KEY = 0 : _
  1737.          CALL DELAYIT (3)
  1738.       SHELL DISK.FOR.DOS$ + _
  1739.             "COMMAND"
  1740.       CLS
  1741.       IF NOT LOCAL.USER THEN _
  1742.          CALL CARRIER : _
  1743.          IF SUBROUTINE.PARAMETER = -1 THEN _
  1744.             GOTO 33970
  1745.       SUBROUTINE.PARAMETER = 2
  1746.       CALL LINE25
  1747.       CALL QTPUT ("Sysop back from DOS.  Returning control to you.",1)
  1748.       COMMPORT.STACK$ = CARRIAGE.RETURN$
  1749.       GOTO 33970
  1750. '
  1751. ' *
  1752. ' * F3 - COMMAND FROM LOCAL KEYBOARD (PRINTER TOGGLE)                         *
  1753. ' *
  1754. '
  1755. 33000 PRINTER = NOT PRINTER
  1756.       CHANGE.VALUE = PRINTER
  1757.       FIELD.POSITION = 38
  1758.       GOTO 33950
  1759. '
  1760. ' *
  1761. ' * F4 - COMMAND FROM LOCAL KEYBOARD (SYSOP ANNOY)                            *
  1762. ' *
  1763. '
  1764. 33040 SYSOP.ANNOY = NOT SYSOP.ANNOY
  1765.       CHANGE.VALUE = SYSOP.ANNOY
  1766.       FIELD.POSITION = 34
  1767.       GOTO 33950
  1768. '
  1769. ' *
  1770. ' * F5 - COMMAND FROM LOCAL KEYBOARD (FORCE CALLER ONLINE)                    *
  1771. ' *
  1772. '
  1773. 33060 FUNCTION.KEY = 0
  1774.       SUBROUTINE.PARAMETER = -3
  1775.       GOTO 33970
  1776. '
  1777. ' *
  1778. ' * F6 - COMMAND FROM LOCAL KEYBOARD (SYSOP AVAILABLE TOGGLE)                 *
  1779. ' *  6 - COMMAND FROM SYSOP MENU (SYSOP AVAILABLE TOGGLE)                     *
  1780. ' *
  1781. '
  1782. 33070 SYSOP.AVAILABLE = NOT SYSOP.AVAILABLE
  1783.       CHANGE.VALUE = SYSOP.AVAILABLE
  1784.       FIELD.POSITION = 32
  1785.       GOTO 33950
  1786. '
  1787. ' *
  1788. ' * F7 - COMMAND FROM LOCAL KEYBOARD (SYSOP GETS SYSTEM NEXT)                 *
  1789. ' *
  1790. '
  1791. 33090 IF ERR=61 AND NOT DISKFULL.GO.OFFLINE THEN _
  1792.          GOTO 33970
  1793.       SYSOP.NEXT = NOT SYSOP.NEXT
  1794.       CHANGE.VALUE = SYSOP.NEXT
  1795.       FIELD.POSITION = 36
  1796.       GOTO 33950
  1797. '
  1798. ' *
  1799. ' * F8 - COMMAND FROM LOCAL KEYBOARD (ASSIGN USER TEMPORARY SYSOP SECURITY)   *
  1800. ' *
  1801. '
  1802. 33110 SYSOP = NOT SYSOP
  1803.       CURSOR.LINE = CSRLIN
  1804.       CURSOR.ROW = POS(0)
  1805.       LOCATE 25,1
  1806.       D$ = SPACE$(79)
  1807.       NUM.RETURNS = 0
  1808.       CALL LPRNT (D$,NUM.RETURNS)
  1809.       LOCATE 25,1
  1810.       USER.SECURITY.LEVEL = (1 + SYSOP) * _
  1811.                             USER.SECURITY.SAVE  - _
  1812.                             SYSOP * _
  1813.                             SYSOP.SECURITY.LEVEL
  1814.       D$ = "SYSOP Privileges " + FNOFFON$(SYSOP)
  1815.       CALL LPRNT (D$,NUM.RETURNS)
  1816.       CALL DELAYIT (3)
  1817.       LOCATE CURSOR.LINE,CURSOR.ROW
  1818.       SUBROUTINE.PARAMETER = 1
  1819.       CALL LINE25
  1820.       CALL CALLOPT
  1821.       GOTO 33970
  1822. '
  1823. ' *
  1824. ' * F9 - COMMAND FROM LOCAL KEYBOARD (SNOOP TOGGLE)                           *
  1825. ' *
  1826. '
  1827. 33130 IF NOT SNOOP THEN _
  1828.          SNOOP = TRUE : _
  1829.          LOCATE 24,1,0 : _
  1830.          D$ = "SNOOP ON" : _
  1831.          NUM.RETURNS = 0 : _
  1832.          CALL LPRNT (D$,NUM.RETURNS) : _
  1833.          SUBROUTINE.PARAMETER = 2 : _
  1834.          CALL LINE25 _
  1835.       ELSE LOCATE ,,0 : _
  1836.            SNOOP = FALSE : _
  1837.            CLS
  1838. 33140 CHANGE.VALUE = SNOOP
  1839.       FIELD.POSITION = 58
  1840.       GOTO 33950
  1841. '
  1842. ' *
  1843. ' * F10 - COMMAND FROM LOCAL KEYBOARD (FORCE CHAT WITH USER)                  *
  1844. ' *
  1845. '
  1846. 33150  GOTO 33160                                                     ' KG102601
  1847. 33155 SUBROUTINE.PARAMETER = 1
  1848.       CALL LINE25
  1849.       GOTO 33970
  1850. 33160 CALL UPDTCALR ("Sysop began chat",1)
  1851.       PAGE.STATUS$ = ""                                              ' KG120301
  1852.       CALL SKIPLINE (1)
  1853.       CALL QTPUT ("Hi " + _
  1854.            FIRST.NAME$ + _
  1855.            ", this is " + _
  1856.            SYSOP.FIRST.NAME$ + _
  1857.            " " + _
  1858.            SYSOP.LAST.NAME$ + _
  1859.            "  Sorry to break in to CHAT but..",1)
  1860.       CALL SYSOPCHAT                                                 ' KG102206
  1861.       COMMPORT.STACK$ = CHR$(13)                                     ' KG103003
  1862.       GOTO 33155                                                     ' KG102206
  1863. '
  1864. ' *
  1865. ' * UP / CTRL-UP: INCREASE THE ON-LINE USER'S SECURITY BY ONE / FIVE          *
  1866. ' *
  1867. '
  1868. 33170 USER.SECURITY.LEVEL = USER.SECURITY.LEVEL + _
  1869.                             1 - 4 * (FUNCTION.KEY = 18)
  1870.       GOTO 33190
  1871. '
  1872. ' *
  1873. ' * DOWN / CTRL-DOWN: DECREASE THE ON-LINE USER'S SECURITY BY ONE / FIVE      *
  1874. ' *
  1875. '
  1876. 33180 USER.SECURITY.LEVEL = USER.SECURITY.LEVEL - _
  1877.                             1 + 4 * (FUNCTION.KEY = 19)
  1878. 33190 ADJUSTED.SECURITY = TRUE
  1879.       USER.SECURITY.SAVE = USER.SECURITY.LEVEL
  1880.       SUBROUTINE.PARAMETER = 2
  1881.       CALL LINE25
  1882.       CALL CALLOPT
  1883.       GOTO 33970
  1884. '
  1885. ' *
  1886. ' * PGUP DISPLAY USER PROFILE                                                 *
  1887. ' *
  1888. '
  1889. 33200 IF NOT LOCAL.USER THEN _
  1890.          CALL CARRIER : _
  1891.          IF SUBROUTINE.PARAMETER = -1 THEN _
  1892.             GOTO 33970
  1893.       CALL PAGEUP
  1894.       D$ = MID$("NoviceExPERT",1 -6 * EXPERT.USER,6)
  1895.       GOSUB 33210
  1896.       D$ = "GRAPHICS: " + _
  1897.            MID$("None AsciiColor",GR * 5 + 1,5)
  1898.       GOSUB 33210                                                    ' KG102002
  1899.       D$ = "PROTOCOL : " + _                                         ' KG102002
  1900.            USER.TRANSFER.DEFAULT$                                    ' KG102002
  1901.       GOSUB 33210
  1902.       D$ = "UPPER CASE " + _
  1903.            MID$("and lowerONLY", 1 - 9 * UPPER.CASE,9)
  1904.       GOSUB 33210
  1905.       D$ = "Line Feeds " + FNOFFON$(LINE.FEEDS)
  1906.       GOSUB 33210
  1907.       D$ = "Nulls " + FNOFFON$(NULLS)
  1908.       GOSUB 33210
  1909.       D$ = "Prompt Bell " + FNOFFON$(PROMPT.BELL)
  1910.       GOSUB 33210
  1911.       D$ = MID$("SKIP CHECK",1 -5 * CHECK.BULLETIN.LOGON,5) + _
  1912.            " old BULLETINS on logon."
  1913.       GOSUB 33210
  1914.       D$ = MID$("CHECKSKIP ",1 -5 * SKIP.FILES.LOGON,5) + _
  1915.            " new files on logon."
  1916.       GOSUB 33210
  1917.       'D$ = "Autodownload " + FNOFFON$(AUTODOWNLOAD.DESIRED)
  1918.       'GOSUB 33210
  1919.       GOTO 33970
  1920. 33210 NUM.RETURNS = 1
  1921.       CALL LPRNT(D$,NUM.RETURNS)
  1922.       RETURN
  1923. '
  1924. ' *
  1925. ' * PGDN CLEAR DISPLAY OF USER'S PROFILE                                      *
  1926. ' *
  1927. '
  1928. 33220 IF NOT LOCAL.USER THEN _
  1929.          CALL CARRIER : _
  1930.          IF SUBROUTINE.PARAMETER = -1 THEN _
  1931.             GOTO 33970
  1932.       CLS
  1933.       GOTO 33155
  1934. '
  1935. ' *
  1936. ' * LEFT ARROW - DECREASE THE ON-LINE USER'S TIME BY ONE MINUTE               *
  1937. ' *
  1938. '
  1939. 33240 IF SECONDS.PER.SESSION! > 120 THEN _
  1940.          SECONDS.PER.SESSION! = SECONDS.PER.SESSION! - 60
  1941.       GOTO 33970
  1942. '
  1943. ' *
  1944. ' * CTRL-LEFT ARROW - DECREASE THE ON-LINE USER'S TIME BY FIVE MINUTES        *
  1945. ' *
  1946. '
  1947. 33245 IF SECONDS.PER.SESSION! > 360 THEN _
  1948.          SECONDS.PER.SESSION! = SECONDS.PER.SESSION! - 300
  1949.       GOTO 33970
  1950. '
  1951. ' *
  1952. ' * RIGHT ARROW - INCREASE THE ON-LINE USER'S TIME BY ONE MINUTE              *
  1953. ' *
  1954. '
  1955. 33250 IF SECONDS.PER.SESSION! < 86280 THEN _
  1956.          SECONDS.PER.SESSION! = SECONDS.PER.SESSION! + 60
  1957.       TIME.LOCK.SET = 0
  1958.       GOTO 33970
  1959. '
  1960. ' *
  1961. ' * CTRL-RIGHT ARROW - INCREASE THE ON-LINE USER'S TIME BY FIVE MINUTES       *
  1962. ' *
  1963. '
  1964. 33255 IF SECONDS.PER.SESSION! < 86040 THEN _
  1965.          SECONDS.PER.SESSION! = SECONDS.PER.SESSION! + 300
  1966.       TIME.LOCK.SET = 0
  1967.       GOTO 33970
  1968. '
  1969. ' *
  1970. ' * UPDATE NODE RECORD WITH LOCAL FUNCTION KEY ACTIVITY                       *
  1971. ' *
  1972. '
  1973. 33950 IF SNOOP THEN _
  1974.          SUBROUTINE.PARAMETER = 1 : _
  1975.          CALL LINE25
  1976. 33960 IF CONFERENCE.MODE = TRUE THEN _
  1977.          IF LOCAL.USER THEN _
  1978.             GOTO 33970 _
  1979.          ELSE D$ = "Cannot change status during Conference!" : _
  1980.               GOSUB 33210 : _
  1981.               GOTO 33970
  1982.       SUBROUTINE.PARAMETER = 3
  1983.       CALL FILELOCK
  1984.       IF SUBROUTINE.PARAMETER = -1 THEN _
  1985.          GOTO 33970
  1986.       CALL OPENMSG
  1987.       FIELD 1,128 AS MESSAGE.RECORD$
  1988.       GET 1,NODE.RECORD.INDEX
  1989.       MID$(MESSAGE.RECORD$,FIELD.POSITION,2) = STR$(CHANGE.VALUE)
  1990.       CALL SAVEPROF (2)
  1991.       FIELD 1, 128 AS MESSAGE.RECORD$
  1992. 33970 END SUB
  1993. ' $SUBTITLE: 'PAGEUP - Display user profile to SYSOP'
  1994. ' $PAGE
  1995. '
  1996. '  SUBROUTINE NAME    -- PAGEUP
  1997. '
  1998. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  1999. '                         ACTIVE.USER.NAME$         CURRENT USER NAME
  2000. '                         DOWNLOADS                 # OF FILES DOWNLOADED
  2001. '                         EXPIRATION.DATE$          REGISTRATION EXPIRATION
  2002. '                         LAST.DATE.TIME.ON.SAVE$   LAST DATE & TIME ON SYSTEM
  2003. '                         LAST.MESSAGE.READ         LAST MESSAGE READ BY USER
  2004. '                         PASSWORD.SAVE$            USERS PASSWORD
  2005. '                         TIMES.LOGGED.ON           TIMES USER HAS LOGGED ON
  2006. '                         UPLOADS                   # OF FILES UPLOADED
  2007. '                         USER.SECURITY.SAVE        USERS SECURITY LEVEL
  2008. '
  2009. '  OUTPUT PARAMETERS  --  MESSAGE.RECORD$
  2010. '
  2011. 33990 SUB PAGEUP STATIC
  2012.       CALL LPRNT (" ",1)
  2013.       CALL LPRNT ("USER NAME : " + ACTIVE.USER.NAME$,1)
  2014.       CALL LPRNT ("SECURITY  :" + STR$(USER.SECURITY.SAVE),1)
  2015.       CALL LPRNT ("PASSWORD  :" + PASSWORD.SAVE$,1)
  2016.       CALL LPRNT ("READ MSG. :" + STR$(LAST.MESSAGE.READ),1)
  2017.       CALL LPRNT ("TIMES ON  :" + STR$(TIMES.LOGGED.ON),1)
  2018.       CALL LPRNT ("LAST ON   :" + LAST.DATE.TIME.ON.SAVE$,1)
  2019.       CALL LPRNT ("DOWNLOADS :" + STR$(DOWNLOADS),1)
  2020.       CALL LPRNT ("UPLOADS   :" + STR$(UPLOADS),1)
  2021.     '  IF ENFORCE.UPLOAD.DOWNLOAD.RATIOS THEN 
  2022.          CALL LPRNT ("DL-BYTES  :" + STR$(DLBYTES!),1)  'remove :- here
  2023.          CALL LPRNT ("UL-BYTES  :" + STR$(ULBYTES!),1)
  2024.       IF RESTRICT.BY.DATE THEN _
  2025.          CALL LPRNT ("EXPIRATION: " + EXPIRATION.DATE$,1)
  2026.       CALL LPRNT ("User's Profile",1)
  2027.       END SUB
  2028. ' $SUBTITLE: 'CHKTREMAIN - Kicks off if no time remaining'
  2029. ' $PAGE
  2030. '
  2031. '  SUBROUTINE NAME    -- CHKTREMAIN
  2032. '
  2033. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  2034. '                         TIME.LEFT!
  2035. '  OUTPUT PARAMETERS  --     PARAMETER                    MEANING
  2036. '                         TIME.LEFT!      TIME IN MINUTES LEFT IN SESSION
  2037. '                         TCA!            TIME USED IN SECONDS
  2038. '                         SUBROUTINE.PARAMETER   -1 if no time left
  2039.       SUB CHKTREMAIN (TIME.LEFT!) STATIC
  2040. 41008 CALL TIMEREMAIN (TIME.LEFT!)
  2041.       IF BYPASS.TIME.CHECK THEN _
  2042.          EXIT SUB
  2043.       IF TIME.LEFT! < 0.1 THEN _
  2044.          SUBROUTINE.PARAMETER = -1
  2045.       END SUB
  2046. ' $SUBTITLE: 'TIMEREMAIN - calculates time remaining in a session'
  2047. ' $PAGE
  2048. '
  2049. '  SUBROUTINE NAME    -- TIMEREMAIN
  2050. '
  2051. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  2052. '                         USER.LOGON.TIME!
  2053. '                         SECONDS.PER.SESSION!
  2054. '                         BYPASS.TIME.CHECK
  2055. '  OUTPUT PARAMETERS  --     PARAMETER                    MEANING
  2056. '                         TIME.REMAINING! TIME IN MINUTES LEFT IN SESSION
  2057. '                         TCA!            TIME USED IN SECONDS
  2058.       SUB TIMEREMAIN (TIME.REMAINING!) STATIC
  2059. 41010 TOA! = FRE("A")
  2060.       IF BYPASS.TIME.CHECK THEN _
  2061.          TIME.REMAINING! = SECONDS.PER.SESSION! /60 : _
  2062.          EXIT SUB
  2063.       CALL FINDTIME (TI!)
  2064.       ROLLOVER = FALSE
  2065.       IF TI! > USER.LOGON.TIME! THEN _
  2066.          TCA! = TI! - USER.LOGON.TIME! : _
  2067.          GOTO 41020
  2068.       ROLLOVER = TRUE
  2069.       TCA! = TI! + 86400! - USER.LOGON.TIME!
  2070. 41020 IF TIME.TO.DROP.TO.DOS! = 0 OR _
  2071.          OLD.DAT$ = DATE$ THEN _
  2072.          GOTO 41030
  2073.       IF NOT ROLLOVER AND _
  2074.          USER.LOGON.TIME! + SECONDS.PER.SESSION! => TIME.TO.DROP.TO.DOS! THEN _
  2075.          SECONDS.PER.SESSION! = (TIME.TO.DROP.TO.DOS! - USER.LOGON.TIME!) : _
  2076.          SHORTENED = TRUE
  2077.       IF ROLLOVER AND _
  2078.          USER.LOGON.TIME! + SECONDS.PER.SESSION! - 86400 => TIME.TO.DROP.TO.DOS! THEN _
  2079.          SECONDS.PER.SESSION! = TIME.TO.DROP.TO.DOS! : _
  2080.          SHORTENED = TRUE
  2081.       IF SHORTENED AND NOT TOLD.SHORT THEN _
  2082.          TOLD.SHORT = TRUE : _
  2083.          A$ = "Time shortened for scheduled event" : _
  2084.          CALL RINGCALLER
  2085. 41030 TIME.REMAINING! = (SECONDS.PER.SESSION!-TCA!) / 60
  2086.       TIME.REMAINING! = -(TIME.REMAINING! > 0.0)*TIME.REMAINING!
  2087.       END SUB
  2088. ' $SUBTITLE: 'DISPLAYTR - Display users time remaining'
  2089. ' $PAGE
  2090. '
  2091. '  SUBROUTINE NAME    -- DISPLAYTR
  2092. '
  2093. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  2094. '                         TIME.REMAINING!
  2095. '
  2096. '  OUTPUT PARAMETERS  --     PARAMETER                    MEANING
  2097. '                         TIME.REMAINING! TIME IN MINUTES LEFT IN SESSION
  2098. '
  2099.       SUB DISPLAYTR (TIME.REMAINING!) STATIC
  2100.       CALL TIMEREMAIN (TIME.REMAINING!)
  2101.       CALL QTPUT (STR$(INT(TIME.REMAINING!)) + " min left",1)
  2102.       END SUB
  2103. ' $SUBTITLE: 'AMORPM - subroutine to give time of day in AM/PM format'
  2104. ' $PAGE
  2105. '
  2106. '  SUBROUTINE NAME    -- AMORPM
  2107. '
  2108. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  2109. '                        SUBROUTINE.PARAMETER = 1  GET CURRENT TIME AND DATE
  2110. '                        SUBROUTINE.PARAMETER = 2  CALCULATE TIME AS AM OR PM
  2111. '
  2112. '  OUTPUT PARAMETERS  -- CURRENT.DATE$           CURRENT DATE (MM-DD-YY)
  2113. '                        TIM$                    CURRENT TIME (I.E. 1:13 PM)
  2114. '                        TIME.LOGGEND.ON$        TIME USER LOGGED ON (HH:MM:SS)
  2115. '
  2116. '  SUBROUTINE PURPOSE -- TO SET THE OUTPUT PARAMETERS AS INDICATED AND
  2117. '                        DESCRIBE THE TIME AS "AM" OR "PM."
  2118. '
  2119.       SUB AMORPM STATIC
  2120.       ON SUBROUTINE.PARAMETER GOTO 41500,41510
  2121. '
  2122. ' *
  2123. ' *  CALCULATE CURRENT TIME FOR AM OR PM                                      *
  2124. ' *
  2125. '
  2126. 41500 TIME.LOGGED.ON$ = TIME$
  2127.       CURRENT.DATE$ = DATE$
  2128.       CURRENT.DATE$ = LEFT$(CURRENT.DATE$ ,6) + _
  2129.                       RIGHT$(CURRENT.DATE$ ,2)
  2130. 41510 TIM$ = TIME$
  2131.       IF VAL(MID$(TIM$,1,2)) = 12 THEN _
  2132.          MID$(TIM$,1,2) = RIGHT$(STR$(VAL(MID$(TIM$,1,2))),2) : _
  2133.          TIM$ = LEFT$(TIM$,5) + _
  2134.                 " PM" : _
  2135.          EXIT SUB
  2136.       IF VAL(MID$(TIM$,1,2)) > 11 THEN _
  2137.          MID$(TIM$,1,2) = RIGHT$(STR$(VAL(MID$(TIM$,1,2))-12),2) : _
  2138.          TIM$ = LEFT$(TIM$,5) + _
  2139.                 " PM" : _
  2140.          EXIT SUB
  2141.       TIM$ = LEFT$(TIM$,5) + _
  2142.              " AM"
  2143.       END SUB
  2144. ' $SUBTITLE: 'CARRIER - subroutine to monitor carrier on comm. port'
  2145. ' $PAGE
  2146. '
  2147. '  SUBROUTINE NAME    -- CARRIER
  2148. '
  2149. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  2150. '                         LOCAL.USER = 0               REMOTE USER
  2151. '                         LOCAL.USER = -1              LOCAL KEYBOARD USER
  2152. '                         MODEM.STATUS.REGISTER        ADDRESS OF THE COMMUNI-
  2153. '                                                      CATIONS PORT'S REGISTER
  2154. '                         SUBROUTINE.PARAMETER = -9    DON'T WRITE TO CALLERS
  2155. '                         SUBROUTINE.PARAMETER = -10   SAME AS -9, BUT DON'T
  2156. '                                                      DELAY
  2157. '
  2158. '  OUTPUT PARAMETERS  --  SUBROUTINE.PARAMETER = 0     CARRIER STILL PRESENT
  2159. '                         SUBROUTINE.PARAMETER = -1    CARRIER NOT PRESENT
  2160. '
  2161. '  SUBROUTINE PURPOSE --  TO TEST IF CARRIER IS PRESENT (I.E. THE USER
  2162. '                         STILL ON LINE).
  2163. '
  2164.       SUB CARRIER STATIC
  2165.       IF SUBROUTINE.PARAMETER = -1 THEN _
  2166.          EXIT SUB
  2167.       SPEEDY = SUBROUTINE.PARAMETER
  2168.       SUBROUTINE.PARAMETER = 0
  2169. '
  2170. ' *
  2171. ' * TEST FOR CARRIER PRESENT (DROP CALLER IF CARRIER NOT PRESENT)             *
  2172. ' *
  2173. '
  2174. 42000 IF LOCAL.USER THEN _
  2175.          EXIT SUB
  2176.       IF FOSSIL THEN _
  2177.          CALL FOSSTATUS(COMPORT%,STATUS%) : _
  2178.          STATUS% = STATUS% AND &H0080 : _
  2179.          IF STATUS% = &H0080 THEN _
  2180.             EXIT SUB _
  2181.          ELSE GOTO 42015
  2182. 42010 IF INP(MODEM.STATUS.REGISTER) > 127 THEN _
  2183.          EXIT SUB
  2184. '
  2185. ' *
  2186. ' * IN CASE USER IS 2400 BAUD, PAUSE A SECOND AND CHECK AGAIN FOR CARRIER     *
  2187. ' * DETECT.  SOME 2400 BAUD MODEMS TAKE A WHILE TO SYNCHRONIZE THE CARRIER,   *
  2188. ' * HENCE A THREE-SECOND PAUSE BEFORE CHECKING AGAIN.                         *
  2189. ' *
  2190. '
  2191. 42015 IF SPEEDY = -10 THEN _
  2192.          GOTO 42020
  2193.       CALL DELAYIT (MODEM.INIT.WAIT.TIME)
  2194.       IF FOSSIL THEN _
  2195.          CALL FOSSTATUS(COMPORT%,STATUS%) : _
  2196.          STATUS% = STATUS% AND &H0080 : _
  2197.          IF STATUS% = &H0080 THEN _
  2198.             EXIT SUB
  2199.       IF INP(MODEM.STATUS.REGISTER) > 127 THEN _
  2200.          EXIT SUB
  2201. 42020 SUBROUTINE.PARAMETER = -1
  2202.       IF SPEEDY < -8 THEN _
  2203.          EXIT SUB
  2204.       IF ALREADY.WRITTEN = -9 THEN _
  2205.          EXIT SUB
  2206.       CALL MODEMPUT (MODEM.GO.OFFHOOK.COMMAND$)
  2207.       CALL DELAYIT (MODEM.COMMAND.DELAY.TIME)
  2208.       MODEM.OFFHOOK = -1
  2209.       ALREADY.WRITTEN = -9
  2210. ' Pe 03/22/89  Auto Log off fix
  2211. IF DOWNLOAD.COMPLETED AND AUTO.END = 1 THEN _
  2212.       CALL UPDTCALR (" Used Auto Logg Off ",1) _
  2213. ELSE _
  2214.       CALL UPDTCALR ("Carrier dropped",1)
  2215.       END SUB
  2216. ' $SUBTITLE: 'ASKGRAPH -- subroutine to ask users graphic preference'
  2217. ' $PAGE
  2218. '
  2219. '  SUBROUTINE NAME    -- ASKGRAPH
  2220. '
  2221. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  2222. '                         UGD$                         USER GRAPHIC DEFAULT
  2223. '
  2224. '  OUTPUT PARAMETERS  --
  2225. '
  2226. '  SUBROUTINE PURPOSE --  TO DETERMINE USERS GRAPHICS DEFAULT
  2227. '
  2228.       SUB ASKGRAPH (UGD$) STATIC
  2229.       IF EXPERT.USER THEN _
  2230.          GOTO 43007
  2231. 43006 FILE.NAME$ = HELP$(9)
  2232.       CALL BUFFILE (FILE.NAME$,X)
  2233.       IF SUBROUTINE.PARAMETER = -1 THEN _
  2234.          EXIT SUB
  2235. 43007 CALL QTPUT ("GRAPHICS for text files and menus",1)
  2236.       A$ = "Change from " + MID$("NAC",GR+1,1) + " to N)one, A)scii-IBM, C)olor-IBM, H)elp" + PRESS.ENTER.EXPERT$
  2237.       SUBROUTINE.PARAMETER = 1
  2238.       TURBO.KEY = -TURBO.KEY.USER
  2239.       CALL TGET
  2240.       IF SUBROUTINE.PARAMETER = -1 THEN _
  2241.          EXIT SUB
  2242.       IF Q = 0 THEN _
  2243.          CALL QTPUT ("Unchanged",1) : _
  2244.          EXIT SUB
  2245.       CALL ALLCAPS (B$(1))
  2246.       GR = INSTR("NAC",B$(1))
  2247.       IF GR = 2 AND NOT EIGHT.BIT THEN _
  2248.          CALL QTPUT ("Ascii unavailable.  Requires 8 bit",1) : _
  2249.          GOTO 43007
  2250.       IF GR = 0 THEN _
  2251.          GOTO 43006
  2252.       GR = GR - 1
  2253.       CALL SETUGD (GR,UGD$)
  2254.       CALL GETCOLOR
  2255.       END SUB
  2256. '
  2257. ' $SUBTITLE: 'GRAPHIC - subroutine to find graphic version of a file'
  2258. ' $PAGE
  2259. '
  2260. '  SUBROUTINE NAME    -- GRAPHIC
  2261. '
  2262. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  2263. '                            DEFAULT$          USERS GRAPHIC DEFAULT
  2264. '                            GR                WHETHER GRAPHICS ARE AVAILABLE
  2265. '                            FILE.NAME$        FILE TO CHECK
  2266. '
  2267. '  OUTPUT PARAMETERS  --     FILE.NAME$        SUBSTITUTES NAME OF GRAPHICS
  2268. '                                              FILE (IF IT EXISTS).
  2269. '
  2270. '  SUBROUTINE PURPOSE -- CHECKS WHETHER THERE IS A GRAPHICS VERSION OF
  2271. '                        A FILE, BASED ON USERS GRAPHICS PREFERENCE.
  2272. '                        SETS FILE NAME TO GRAPHICS FILE IF IT EXISTS,
  2273. '                        OTHERWISE LEAVES FILE NAME INTACT.  RETURNS FILE
  2274. '                        NAME TO USE.
  2275. '
  2276.       SUB GRAPHIC (DEFAULT$) STATIC
  2277. 43031 OK = FALSE
  2278.       IF GR THEN _
  2279.          CALL BRKFNAME (FILE.NAME$,DR$,X$,EXTENTION$,TRUE) : _
  2280.          IF LEN(X$) < 8 THEN _
  2281.             DF$ = DR$ + _
  2282.                   X$ + _
  2283.                   DEFAULT$ + _
  2284.                   EXTENTION$ : _
  2285.              CALL FINDIT (DF$) : _
  2286.              IF OK THEN _
  2287.                 FILE.NAME$ = DF$ : _
  2288.                 IF DEFAULT$ = "C" THEN _
  2289.                    LINES.PRINTED = 0
  2290.       IF NOT OK THEN _
  2291.          CALL FINDIT (FILE.NAME$)
  2292.       END SUB
  2293. ' $SUBTITLE: 'SAVEPROF - subroutine to read a user profile'
  2294. ' $PAGE
  2295. '
  2296. '  SUBROUTINE NAME    -- SAVEPROF
  2297. '
  2298. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  2299. '                        BPS
  2300. '                        EIGHT.BIT
  2301. '                        EXIT.TO.DOORS
  2302. '                        GR
  2303. '                        KERMIT.FUNCTION
  2304. '                        MESSAGE.RECORD$
  2305. '                        NODE.RECORD.INDEX
  2306. '                        SYSOP
  2307. '                        UPPER.CASE
  2308. '                        TIME.LOGGED.ON$
  2309. '                        PRIVATE.DOOR
  2310. '                        RELIABLE.MODE
  2311. '
  2312. '  OUTPUT PARAMETERS  -- NONE
  2313. '
  2314. '  SUBROUTINE PURPOSE -- SAVES A USER'S OPTIONS AND COMMUNICATIONS PARAMETERS
  2315. '                        IN THE NODE RECORD WHEN A USER EXITS TO A "DOOR" SO
  2316. '                        THAT HE IS IN THE SAME STATUS AS WHEN HE EXITED.
  2317. '
  2318.       SUB SAVEPROF(IPARM) STATIC
  2319.       ON IPARM GOTO 43070,43080
  2320. '
  2321. ' *
  2322. ' *  SAVE USER PROFILE WHEN EXITING                                           *
  2323. ' *
  2324. '
  2325. 43070 ACTIVE.MESSAGE.FILE$ = ORIG.MESSAGE.FILE$
  2326.       SUBROUTINE.PARAMETER = 3
  2327.       CALL FILELOCK
  2328.       CALL OPENMSG
  2329.       FIELD 1, 128 AS MESSAGE.RECORD$
  2330.       GET 1,NODE.RECORD.INDEX
  2331.       IF GLOBAL.SYSOP THEN _                                         ' KG101404
  2332.          MID$(MESSAGE.RECORD$,1,30) = "SYSOP" + SPACE$(25)           ' KG101404
  2333.       MID$(MESSAGE.RECORD$,40,2) = STR$(EXIT.TO.DOORS)
  2334.       MID$(MESSAGE.RECORD$,42,2) = STR$(EIGHT.BIT)
  2335.       MID$(MESSAGE.RECORD$,44,2) = STR$(BPS)
  2336.       MID$(MESSAGE.RECORD$,46,2) = STR$(UPPER.CASE)
  2337.       MID$(MESSAGE.RECORD$,48,5) = MKS$(NUM.DWN.BYTS!) + MID$(STR$(-BATCH.TRANSFER),2)
  2338.       MID$(MESSAGE.RECORD$,53,2) = STR$(GR)
  2339.       MID$(MESSAGE.RECORD$,55,2) = STR$(SYSOP)
  2340.       MID$(MESSAGE.RECORD$,65,3) = CHR$(VAL(LEFT$(TIME.LOGGED.ON$,2))) + _
  2341.                                    CHR$(VAL(MID$(TIME.LOGGED.ON$,4,2))) + _
  2342.                                    CHR$(VAL(MID$(TIME.LOGGED.ON$,7,2)))
  2343.       MID$(MESSAGE.RECORD$,72,2) = STR$(PRIVATE.DOOR)
  2344.       MID$(MESSAGE.RECORD$,74,1) = MID$(STR$(TRANSFER.FUNCTION),2,1)
  2345.       MID$(MESSAGE.RECORD$,75,1) = FT$
  2346.       MID$(MESSAGE.RECORD$,91,2) = STR$(RELIABLE.MODE)
  2347.       CALL BRKFNAME (CURRENT.PUI$,A$,B$,Z$,FALSE)
  2348.       MID$(MESSAGE.RECORD$,93,8) = B$ + SPACE$(8 - LEN(B$))
  2349.       MID$(MESSAGE.RECORD$,101,2) = STR$(LOCAL.USER)
  2350.       MID$(MESSAGE.RECORD$,103,2) = STR$(LOCAL.USER.MODE)
  2351.       GRN$ = LEFT$(GRN$,INSTR(GRN$ + " "," ") - 1)
  2352.       MID$(MESSAGE.RECORD$,105,8) = GRN$ + SPACE$(8 - LEN(GRN$))
  2353.       MID$(MESSAGE.RECORD$,117,2) = STR$(MENU.INDEX)
  2354.       MID$(MESSAGE.RECORD$,119,2) = LEFT$(DATE$,2)
  2355.       MID$(MESSAGE.RECORD$,121,2) = MID$(DATE$,4,2)
  2356.       MID$(MESSAGE.RECORD$,123,2) = RIGHT$(DATE$,2)
  2357.       MID$(MESSAGE.RECORD$,125,2) = LEFT$(TIME$,2)
  2358.       MID$(MESSAGE.RECORD$,127,2) = MID$(TIME$,4,2)
  2359. 43080 PUT 1,NODE.RECORD.INDEX
  2360.       SUBROUTINE.PARAMETER = 2
  2361.       CALL FILELOCK
  2362.       CALL OPENMSG
  2363.       END SUB
  2364. ' $SUBTITLE: 'READPROF - subroutine to restore a user profile'
  2365. ' $PAGE
  2366. '
  2367. '  SUBROUTINE NAME    -- READPROF
  2368. '
  2369. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  2370. '                        NODE.RECORD.INDEX     NODE RECORD TO USE
  2371. '                        SYSOP.PASSWORD.1$     SYSOP'S PSEUDONYM 1
  2372. '                        SYSOP.PASSWORD.2$     SYSOP'S PSEUDONYM 2
  2373. '
  2374. '  OUTPUT PARAMETERS  -- USER'S OPTIONS AND COMMUNICATIONS PARAMETERS
  2375. '                        UPON EXITING RBBS-PC TO A "DOOR"
  2376. '
  2377. '  SUBROUTINE PURPOSE -- RESET A USER'S OPTIONS AND COMMUNICATIONS PARAMETERS
  2378. '                        THAT WERE SAVED IN THE NODE RECORD WHEN A USER EXITED
  2379. '                        TO A "DOOR" SO THAT HE IS IN THE SAME STATUS AS WHEN
  2380. '                        HE EXITED.
  2381. '
  2382.       SUB READPROF STATIC
  2383. '
  2384. ' *
  2385. ' *  RESTORE USER PROFILE WHEN RETURNING FROM DOORS                           *
  2386. ' *
  2387. '
  2388. 44000 LOCATE 24,1
  2389.       CALL LPRNT("NODE INDEX" + STR$(NODE.RECORD.INDEX),1)
  2390.       FIELD 1, 128 AS MESSAGE.RECORD$
  2391.       GET 1,NODE.RECORD.INDEX
  2392.       RELIABLE.MODE = VAL(MID$(MESSAGE.RECORD$,91,2))
  2393.       MID$(MESSAGE.RECORD$,40,2) = "00"
  2394.       EIGHT.BIT = VAL(MID$(MESSAGE.RECORD$,42,2))
  2395.       BPS = VAL(MID$(MESSAGE.RECORD$,44,2))
  2396.       CALL COMMINFO
  2397.       BAUD.TEST = VAL(MID$("      300  450 1200 2400 4800 960019200",(-5 * BPS),5))
  2398.       UPPER.CASE = VAL(MID$(MESSAGE.RECORD$,46,2))
  2399.       NUM.DWN.BYTS! = CVS(MID$(MESSAGE.RECORD$,48,4))
  2400.       BATCH.TRANSFER = (MID$(MESSAGE.RECORD$,52,1) = "1")
  2401.       GR = VAL(MID$(MESSAGE.RECORD$,53,2))
  2402.       CALL GETCOLOR
  2403.       TIME.LOGGED.ON$ = RIGHT$("0"+MID$(STR$(ASC(MID$(MESSAGE.RECORD$,65,1))),2),2) + _
  2404.                         ":" + _
  2405.                         RIGHT$("0"+MID$(STR$(ASC(MID$(MESSAGE.RECORD$,66,1))),2),2) + _
  2406.                         ":" + _
  2407.                         RIGHT$("0"+MID$(STR$(ASC(MID$(MESSAGE.RECORD$,67,1))),2),2)
  2408.       TRANSFER.FUNCTION = VAL(MID$(MESSAGE.RECORD$,74,1))
  2409.       FT$ = MID$(MESSAGE.RECORD$,75,1)
  2410.       MENU.INDEX = VAL(MID$(MESSAGE.RECORD$,117,2))
  2411.       CURRENT.PUI$ = MID$(MESSAGE.RECORD$,93,8)
  2412.       CALL REMOVE (CURRENT.PUI$," ")
  2413.       IF CURRENT.PUI$ <> "" THEN _
  2414.          CALL BRKFNAME (MAIN.PUI$,A$,B$,Z$,TRUE) : _
  2415.          CURRENT.PUI$ = A$ + CURRENT.PUI$ + Z$
  2416.       CUSTOM.PUI = (CURRENT.PUI$ <> "")
  2417.       LOCAL.USER = VAL(MID$(MESSAGE.RECORD$,101,2))
  2418.       LOCAL.USER.MODE = VAL(MID$(MESSAGE.RECORD$,103,2))
  2419.       HOME.CONFERENCE$ = MID$(MESSAGE.RECORD$,105,8)
  2420.       CALL TRIM (HOME.CONFERENCE$)
  2421.       IF REQUIRED.RINGS > 0 AND _
  2422.          INSTR(MODEM.INIT.COMMAND$,"S0=255") THEN _
  2423.          COLOR 7,0,0 _
  2424.       ELSE COLOR FG,BG,BORDER
  2425.       IF LOCAL.USER.MODE THEN _
  2426.          GOTO 44003
  2427.       CALL SETBAUD
  2428. 44003 CALL FINDTIME (USER.LOGON.TIME!)
  2429.       IF MINUTES.PER.SESSION! < 1 THEN _
  2430.          MINUTES.PER.SESSION! = 3
  2431.       IF NOT EIGHT.BIT THEN _
  2432.          OUT LINE.CONTROL.REGISTER,&H1A
  2433.       IF LEFT$(MESSAGE.RECORD$,7) = "SYSOP  " THEN _                 ' KG101404
  2434.          ACTIVE.USER.NAME$ = SYSOP.PASSWORD.1$ + " " + SYSOP.PASSWORD.2$ _ ' KG101404
  2435.       ELSE FIRST.NAME.END = INSTR(MESSAGE.RECORD$," ") : _           ' KG101404
  2436.            LAST.NAME.END = INSTR(FIRST.NAME.END + 1,MESSAGE.RECORD$ + " ","  ") : _ ' KG101404
  2437.            FIRST.NAME$ = LEFT$(MESSAGE.RECORD$,FIRST.NAME.END-1) : _ ' KG101404
  2438.            LAST.NAME$ = MID$(MESSAGE.RECORD$,FIRST.NAME.END + 1,LAST.NAME.END - (FIRST.NAME.END + 1)) : _ ' KG101404
  2439.            ACTIVE.USER.NAME$ = MID$(FIRST.NAME$ + " " + LAST.NAME$,1,31) ' KG101404
  2440.       Z$ = FIRST.NAME$
  2441.       END SUB
  2442. ' $SUBTITLE: 'COMMINFO - subroutine for variable of users baud/parity'
  2443. ' $PAGE
  2444. '
  2445. '  SUBROUTINE NAME    -- COMMINFO
  2446. '
  2447. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  2448. '                              BPS               BAUD RATE INDICATOR
  2449. '                            EIGHT.BIT           INDICATE FOR N/8/1
  2450. '
  2451. '  OUTPUT PARAMETERS  -- BAUD.PARITY$
  2452. '
  2453. '  SUBROUTINE PURPOSE -- CREATE A STRING THAT SHOWS A USERS BAUD RATE AND
  2454. '                        PARITY.
  2455. '
  2456.       SUB COMMINFO STATIC
  2457. '
  2458. ' *
  2459. ' *  DETERMINE BAUD AND PARITY                                                *
  2460. ' *
  2461. '
  2462.   IF RELIABLE.MODE THEN _
  2463.      RELIABLE.MODE$ = "-R," _
  2464.   ELSE RELIABLE.MODE$ = ","
  2465.   BAUD.PARITY$ = MID$("      300  450 1200 2400 4800 960019200",(-5 * BPS),5) + _
  2466.                  " BAUD" + _
  2467.                  RELIABLE.MODE$ + _
  2468.                  MID$("N,8,1E,7,1",6 + 5 * EIGHT.BIT,5)
  2469.   BAUD.TEST = VAL(BAUD.PARITY$)
  2470.   END SUB
  2471. ' $SUBTITLE: 'DELAYIT - subroutine to wait number of seconds specified'
  2472. ' $PAGE
  2473. '
  2474. '  SUBROUTINE NAME    -- DELAYIT
  2475. '
  2476. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  2477. '                             DELAY.TIME           NUMBER OF SECONDS TO DELAY
  2478. '                                                  (0 TO 3,600)
  2479. '
  2480. '  OUTPUT PARAMETERS  -- NONE
  2481. '
  2482. '  SUBROUTINE PURPOSE -- TO WAIT THE NUMBER OF SECONDS INDICATED BEFORE
  2483. '                        RETURNING CONTROL TO THE CALLING ROUTINE.
  2484. '
  2485.       SUB DELAYIT (DELAY.TIME) STATIC
  2486.       IF DELAY.TIME < 1 THEN _
  2487.          EXIT SUB
  2488.       CALL FINDTIME (DELAY!)
  2489.       DELAY! = DELAY.TIME + DELAY!
  2490.       IF DELAY! < 86400! THEN _
  2491.          GOTO 50520
  2492. 50500 CALL FINDTIME (TI!)
  2493.       IF TI! > DELAY.TIME THEN _  ' IF SECONDS TO DELAY IS PAST
  2494.          GOTO 50500              ' MIDNIGHT WAIT FOR THE CLOCK TO WRAP AROUND
  2495.       DELAY! = DELAY! - 86400!   ' TO PAST MIDNIGHT AND ADJUST THE DELAY
  2496. 50520 CALL FINDTIME (TI!)
  2497.       IF TI! < DELAY! THEN _
  2498.          GOTO 50520
  2499.       END SUB
  2500. ' $SUBTITLE: 'MODEMPUT - subroutine to write modem commands to modem'
  2501. ' $PAGE
  2502. '
  2503. '  SUBROUTINE NAME    -- MODEMPUT
  2504. '
  2505. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  2506. '                        STRNG$                    MODEM COMMAND
  2507. '                        COMMANDS.BETWEEN.RINGS    INDICATOR TO WAIT FOR
  2508. '                                                  MODEM TO STOP RINGING
  2509. '                                                  BEFORE ISSUING COMMANDS
  2510. '                        DUMB.MODEM                INDICATOR THAT MODEM WOULD
  2511. '                                                  NOT UNDERSTAND COMMANDS
  2512. '
  2513. '  OUTPUT PARAMETERS  -- NONE
  2514. '
  2515. '  SUBROUTINE PURPOSE -- TO ISSUE MODEM COMMANDS TO THE MODEM
  2516. '
  2517.       SUB MODEMPUT (STRNG$) STATIC
  2518. '
  2519. ' *
  2520. ' *  SEND MODEM COMMAND                                                       *
  2521. ' *
  2522. '
  2523. 52070 IF DUMB.MODEM THEN _
  2524.          EXIT SUB
  2525.       IF NOT COMMANDS.BETWEEN.RINGS OR _
  2526.          NOT (INP(MODEM.STATUS.REGISTER) AND &H40) THEN _
  2527.          GOTO 52080
  2528.       CALL SETABORT (CONNECT.DELAY!,7)
  2529. 52072 IF (INP(MODEM.STATUS.REGISTER) AND &H40) > 0 THEN _
  2530.          CALL FINDTIME (TI!) : _
  2531.          IF TI! > CONNECT.DELAY! OR _
  2532.             (ABS(CONNECT.DELAY! - TI!) > 30 AND _
  2533.              (TI! + 86400 > CONNECT.DELAY!)) THEN _
  2534.             GOTO 52080
  2535.       GOTO 52072
  2536. 52080 CALL DELAYIT (MODEM.COMMAND.DELAY.TIME)
  2537.       IF FOSSIL THEN _
  2538.          STRNG$ = STRNG$ + CARRIAGE.RETURN$ : _          'KG121804
  2539.          BYTES% = LEN(STRNG$) : _
  2540.          CALL FOSWRITE(COMPORT%,BYTES%,STRNG$) _
  2541.       ELSE PRINT #3,STRNG$;CARRIAGE.RETURN$             'KG120902
  2542.       END SUB
  2543. ' $SUBTITLE: 'DISPCALL - subroutine to display callers file'
  2544. ' $PAGE
  2545. '
  2546. '  SUBROUTINE NAME    -- DISPCALL
  2547. '
  2548. '  INPUT PARAMETERS   --     PARAMETER           MEANING
  2549. '
  2550. '  OUTPUT PARAMETERS  --  (NONE)
  2551. '
  2552. '  SUBROUTINE PURPOSE -- DISPLAYS CALLERS FILE TO SYSOPS AND CALLERS
  2553. '
  2554. 57001 SUB DISPCALL STATIC
  2555.       IF CALLERS.FILE.PREFIX$ = "" THEN _                      'KG102705
  2556.          EXIT SUB
  2557.       CALL SKIPLINE (1)
  2558.       CALLERS.FILE.INDEX.TEMP! = CALLERS.FILE.INDEX!
  2559.       CLOSE 4
  2560.       IF SHARE.IT THEN _
  2561.          OPEN CALLERS.FILE$ FOR RANDOM SHARED AS #4 LEN=64 _   'KG102505
  2562.       ELSE OPEN "R",4,CALLERS.FILE$,64
  2563.       FIELD 4,64 AS CALLERS.RECORD$
  2564. 57005 IF CALLERS.FILE.INDEX.TEMP! < 1 OR RET THEN _
  2565.          EXIT SUB
  2566. 57010 GET 4,CALLERS.FILE.INDEX.TEMP!
  2567.       A$ = CALLERS.RECORD$
  2568.       IF LEFT$(A$,3) = "   " OR _
  2569.          INSTR(A$,"on at") = 0 THEN _
  2570.          GOTO 57030
  2571. 57025 CALLERS.FILE.INDEX.TEMP! = CALLERS.FILE.INDEX.TEMP! - 1
  2572.       GET 4,CALLERS.FILE.INDEX.TEMP!
  2573.       Z = INSTR(CALLERS.RECORD$,"{")
  2574.       IF Z < 1 OR Z > 15 THEN _
  2575.          Z = 15
  2576.       IF SYSOP OR _
  2577.          LEFT$(A$,3) <> "   " THEN _
  2578.          A$ = A$ + LEFT$(CALLERS.RECORD$,Z - 1)
  2579.       GOSUB 57100
  2580.       IF SYSOP THEN _
  2581.          A$ = MID$(CALLERS.RECORD$,Z) : _
  2582.          GOSUB 57100
  2583.       GOTO 57045
  2584. 57030 IF SYSOP THEN _
  2585.          GOSUB 57100
  2586. 57045 CALLERS.FILE.INDEX.TEMP! = CALLERS.FILE.INDEX.TEMP! -1
  2587.       GOTO 57005
  2588. 57100 IF INSTR(A$,"LOGON DENIED") THEN _
  2589.          IF NOT SYSOP THEN _
  2590.             RETURN
  2591.       CALL QTPUT (A$,1)
  2592.       CALL ASKMORE ("",TRUE,TRUE,X,FALSE)
  2593.       IF NO OR SUBROUTINE.PARAMETER = -1 THEN _
  2594.          EXIT SUB
  2595.       RETURN
  2596.       END SUB
  2597. ' $SUBTITLE: 'FINDTIME - subroutine to calculate seconds since midnight'
  2598. ' $PAGE
  2599. '
  2600. '  SUBROUTINE NAME    -- FINDTIME
  2601. '
  2602. '  INPUT PARAMETERS   --     PARAMETER           MEANING
  2603. '                            SECONDS!          VARIABLE TO RETURN RESULTS WITH
  2604. '
  2605. '  OUTPUT PARAMETERS  --     SECONDS!          SECONDS SINCE MIDNIGHT
  2606. '
  2607. '  SUBROUTINE PURPOSE -- TO CALCULATE THE NUMBER OF SECONDS THAT HAVE
  2608. '                        ELASPED SINCE MIDNIGHT
  2609. '
  2610.       SUB FINDTIME (SECONDS!) STATIC
  2611. 58050 SECONDS! = TIMER
  2612.       END SUB
  2613. ' $SUBTITLE: 'ALLCAPS - subroutine to convert string to upper case'
  2614. ' $PAGE
  2615. '
  2616. '  SUBROUTINE NAME    -- ALLCAPS
  2617. '
  2618. '  INPUT PARAMETERS   --     PARAMETER           MEANING
  2619. '                            CONVERT.FIELD$    STRING TO MAKE UPPER CASE
  2620. '
  2621. '  OUTPUT PARAMETERS  --     CONVERT.FIELD$    CONVERTED STRINGS
  2622. '
  2623. '  SUBROUTINE PURPOSE -- SUBROUTINE TO CONVERT A STRING TO UPPER CASE
  2624. '
  2625.       SUB ALLCAPS (CONVERT.FIELD$) STATIC
  2626. 58060 IF TURBO.RBBS THEN _
  2627.          CALL RBBSULC (CONVERT.FIELD$) : _
  2628.          EXIT SUB
  2629.       FOR Z = 1 TO LEN(CONVERT.FIELD$)
  2630.          IF MID$(CONVERT.FIELD$,Z,1) > "@" THEN _
  2631.             MID$(CONVERT.FIELD$,Z,1) = CHR$(ASC(MID$(CONVERT.FIELD$,Z,1)) AND 223)
  2632.       NEXT
  2633.       END SUB
  2634. ' $SUBTITLE: 'CHECKTIM - subroutine to see if time has elasped'
  2635. ' $PAGE
  2636. '
  2637. '  SUBROUTINE NAME    -- CHECKTIM
  2638. '
  2639. '  INPUT PARAMETERS   --     PARAMETER           MEANING
  2640. '                            MAX.TIME!         NUMBER OF SECONDS PAST MIDNIGHT
  2641. '                                              NOT TO EXCEED
  2642. '
  2643. '  OUTPUT PARAMETERS  -- SUBROUTINE.PARAMETER = 1 CURRENT TIME IS LESS THAN
  2644. '                                                 MAX.TIME!
  2645. '                        SUBROUTINE.PARAMETER = 2 CURRENT TIME IS GREATER THAN
  2646. '                                                 OR EQUAL TO MAX.TIME!
  2647. '
  2648. '  SUBROUTINE PURPOSE -- SUBROUTINE TO CHECK IF THE CURRENT TIME IS GREATER
  2649. '                        THAN OR EQUAL TO THE TIME ALLOWED
  2650. '
  2651.       SUB CHECKTIM (MAX.TIME!) STATIC
  2652. 58070 SUBROUTINE.PARAMETER = 1
  2653.       CALL FINDTIME (TI!)
  2654.       IF MAX.TIME! < 86400 AND TI! < MAX.TIME! THEN _
  2655.          EXIT SUB
  2656.       IF MAX.TIME! < 86400 AND TI! => MAX.TIME! THEN _
  2657.          SUBROUTINE.PARAMETER = 2 : _
  2658.          EXIT SUB
  2659.       TEST.TIME! = MAX.TIME! - 86400
  2660.       IF TEST.TIME! - TI! <= 0 THEN _
  2661.          EXIT SUB
  2662.       IF TI! => TEST.TIME! THEN _
  2663.          SUBROUTINE.PARAMETER = 2
  2664.       END SUB
  2665. ' $SUBTITLE: 'HASHRBBS - subroutine to determine where to look for user'
  2666. ' $PAGE
  2667. '
  2668. '  SUBROUTINE NAME    -- HASHRBBS
  2669. '
  2670. '  INPUT PARAMETERS   --     PARAMETER           MEANING
  2671. '                            STRNG.TO.HASH$    USER NAME TO LOCATE
  2672. '                            MAX.POSITION      MAXIMUM # USERS
  2673. '
  2674. '  OUTPUT PARAMETERS  --     PRIME.HASH        WHERE TO LOOK FIRST
  2675. '                            SECOND.HASH       LOOK THIS FAR AHEAD
  2676. '
  2677. '  SUBROUTINE PURPOSE -- WHERE TO LOOK FOR A USER IN USERS FILE
  2678. '                        LOOK FIRST AT PRIME POSITION, THEN ADD
  2679. '                        SECOND.HASH UNTIL FIND OR FIND UNUSED RECORD
  2680. '
  2681.       SUB HASHRBBS (STRNG.TO.HASH$,MAX.POSITION,PRIME.HASH,SECOND.HASH) STATIC
  2682. 58080 SECOND.HASH = (ASC(MID$(STRNG.TO.HASH$,2,1)) * 10  + 7) MOD _
  2683.            MAX.POSITION
  2684.       PRIME.HASH = _
  2685.            ((ASC(STRNG.TO.HASH$) * 100  + _
  2686.              ASC(MID$(STRNG.TO.HASH$,(LEN(STRNG.TO.HASH$) / 2) + .1,1)) * _
  2687.              10  + _
  2688.              ASC(RIGHT$(STRNG.TO.HASH$,1))) _
  2689.              MOD MAX.POSITION) + 1
  2690.       END SUB
  2691. ' $SUBTITLE: 'CALLOPT - subroutine to set prompts based on user security'
  2692. ' $PAGE
  2693. '
  2694. '  SUBROUTINE NAME    -- CALLOPT
  2695. '
  2696. '  INPUT PARAMETERS   --     PARAMETER           MEANING
  2697. '                            BEG.MAIN          POSITION START OF MAIN CMDS
  2698. '                            BEG.FILE          POSITION START OF FILE CMDS
  2699. '                            BEG.UTIL          POSITION START OF UTIL CMDS
  2700. '                            BEG.LIBRARY       POSITION START OF LIBRARY CMDS
  2701. '
  2702. '  OUTPUT PARAMETERS  -- PRESENT.OPTS$         DISPLAY WHAT USER CAN DO (1st)
  2703. '                        CALLERS.OPTS$         DISPLAY WHAT USER CAN DO (2nd)
  2704. '                        MAIN.OPTS$            MAIN OPTS USER CAN DO
  2705. '                        FILE.OPTS$            FILE OPTS USER CAN DO
  2706. '                        UTIL.OPTS$            UTIL OPTS USER CAN DO
  2707. '                        LIBRARY.OPTS$         LIBRARY OPTS USER CAN DO
  2708. '
  2709. '  SUBROUTINE PURPOSE -- SETS COMMAND LINE DISPLAY OF WHAT USER CAN DO BY
  2710. '                        SECTION AND DISPLAY OF WHAT ALL USER CAN DO
  2711. '
  2712.       SUB CALLOPT STATIC
  2713. 58090 FIRST = BEG.MAIN
  2714.       LAST = BEG.FILE - 1
  2715.       CALL SETOPTS (MAIN.OPTS$,INVALID.MAIN.OPTS$,FIRST,LAST)
  2716.       FIRST = BEG.FILE
  2717.       LAST = BEG.UTIL - 1
  2718.       CALL SETOPTS (FILE.OPTS$,INVALID.FILE.OPTS$,FIRST,LAST)
  2719.       FIRST = BEG.UTIL
  2720.       LAST = BEG.LIBRARY - 1
  2721.       CALL SETOPTS (UTIL.OPTS$,INVALID.UTIL.OPTS$,FIRST,LAST)
  2722.       FIRST = BEG.LIBRARY
  2723.       LAST = BEG.LIBRARY + 6
  2724.       CALL SETOPTS (LIBRARY.OPTS$,INVALID.LIBRARY.OPTS$,FIRST,LAST)
  2725.       FIRST = 50
  2726.       LAST = 56
  2727.       CALL SETOPTS (SYS.OPTS$,INVALID.SYS.OPTS$,FIRST,LAST)
  2728.       FIRST = 46
  2729.       LAST = 49
  2730.       CALL SETOPTS (GLOBAL.OPTS$,INVALID.GLOBAL.OPTS$,FIRST,LAST)
  2731.       IF LEN(SYS.OPTS$) > 0 THEN _
  2732.          SYSTEM.OPTS$ = "Sysop: " + _
  2733.                         SYS.OPTS$
  2734.       MAIN.OPTS$ = GLOBAL.OPTS$ + _
  2735.                    MAIN.OPTS$
  2736.       FILE.OPTS$ = GLOBAL.OPTS$ + _
  2737.                    FILE.OPTS$
  2738.       UTIL.OPTS$ = GLOBAL.OPTS$ + _
  2739.                    UTIL.OPTS$
  2740.       LIBRARY.OPTS$ = GLOBAL.OPTS$ + _
  2741.                       LIBRARY.OPTS$
  2742.       CALL SRTSTRNG (SYS.OPTS$)
  2743.       CALL SRTSTRNG (MAIN.OPTS$)
  2744.       MAIN.OPTS$ = MAIN.OPTS$ + _
  2745.                    SYS.OPTS$
  2746.       CALL SRTSTRNG (FILE.OPTS$)
  2747.       CALL SRTSTRNG (UTIL.OPTS$)
  2748.       CALL SRTSTRNG (LIBRARY.OPTS$)
  2749.       CALL INSCOMMA (MAIN.OPTS$)
  2750.       CALL INSCOMMA (FILE.OPTS$)
  2751.       CALL INSCOMMA (UTIL.OPTS$)
  2752.       CALL INSCOMMA (LIBRARY.OPTS$)
  2753.       DIR.PROMPT$ = "What directory(s) (" + _
  2754.          MID$("U)pload,A)ll,L)ist,E)xtended +/-, [Q]uit)",8 * (USER.SECURITY.LEVEL => MIN.SEC.TO.VIEW) + 9)
  2755.       QUIT.PROMPT.EXPERT$ = "QUIT C,S, or to F,[M],U,@"
  2756.       QUIT.PROMPT.NOVICE$ = "QUIT C)onference, S)ession or to section " + _
  2757.                             "F)ile, [M]ain, U)til, or @)Library"
  2758.       QUIT.LIST$ = "FMUS@C"
  2759.       IF USER.SECURITY.LEVEL < OPT.SEC(18) THEN _
  2760.          QUIT.PROMPT.EXPERT$ = LEFT$(QUIT.PROMPT.EXPERT$,23) : _
  2761.          QUIT.PROMPT.NOVICE$ = LEFT$(QUIT.PROMPT.NOVICE$,61) : _
  2762.          MID$(QUIT.LIST$,5) = " "
  2763.       IF USER.SECURITY.LEVEL < OPT.SEC(15) THEN _
  2764.          QUIT.PROMPT.EXPERT$ = LEFT$(QUIT.PROMPT.EXPERT$,22) + _
  2765.                                MID$(QUIT.PROMPT.EXPERT$,25) : _
  2766.          QUIT.PROMPT.NOVICE$ = LEFT$(QUIT.PROMPT.NOVICE$,56) + _
  2767.                                MID$(QUIT.PROMPT.NOVICE$,63) : _
  2768.          MID$(QUIT.LIST$,3,1) = " "
  2769.       IF USER.SECURITY.LEVEL < OPT.SEC(6) THEN _
  2770.          QUIT.PROMPT.EXPERT$ = LEFT$(QUIT.PROMPT.EXPERT$,16) + _
  2771.                                MID$(QUIT.PROMPT.EXPERT$,19) : _
  2772.          QUIT.PROMPT.NOVICE$ = LEFT$(QUIT.PROMPT.NOVICE$,41) + _
  2773.                                MID$(QUIT.PROMPT.NOVICE$,49) : _
  2774.          MID$(QUIT.LIST$,1,1) = " "
  2775.       CALL SETSECT
  2776.       END SUB
  2777. ' $SUBTITLE: 'SETOPTS - subroutine to set prompts based on user security'
  2778. ' $PAGE
  2779. '
  2780. '  SUBROUTINE NAME    -- SETOPTS
  2781. '
  2782. '  INPUT PARAMETERS   --     PARAMETER           MEANING
  2783. '                            FIRST             POSITION WHERE START LOOKING
  2784. '                            LAST              POSITION WHERE QUIT LOOKING
  2785. '                            USER.SECURITY.LEVEL SECURITY OF USER
  2786. '
  2787. '  OUTPUT PARAMETERS  -- OPTIONS$              LIST OF COMMANDS USER CAN DO
  2788. '
  2789. '  SUBROUTINE PURPOSE -- STRING TOGETHER WHAT COMMANDS USER CAN DO
  2790. '                        IN A SECTION
  2791. '
  2792.       SUB SETOPTS (OPTIONS$,INVALID.OPTIONS$,FIRST,LAST) STATIC
  2793. 58100 OPTIONS$ = ""
  2794.       INVALID.OPTIONS$ = ""
  2795.       FOR I = FIRST TO LAST
  2796.          IF USER.SECURITY.LEVEL < OPT.SEC(I) THEN _
  2797.             INVALID.OPTIONS$ = INVALID.OPTIONS$ + _
  2798.                                MID$(ALL.OPTS$,I,1) _
  2799.          ELSE IF MID$(ALL.OPTS$,I,1) <> " " THEN _
  2800.                  OPTIONS$ = OPTIONS$ + _
  2801.                             MID$(ALL.OPTS$,I,1)
  2802.       NEXT
  2803.       CALL SRTSTRNG (OPTIONS$)
  2804.       CALL SRTSTRNG (INVALID.OPTIONS$)
  2805.       END SUB
  2806. ' $SUBTITLE: 'CHKNEWBUL - subroutine to check whether got new bulletins'
  2807. ' $PAGE
  2808. '
  2809. '  SUBROUTINE NAME    -- CHKNEWBUL
  2810. '
  2811. '  INPUT PARAMETERS   --     PARAMETER           MEANING
  2812. '                            LAST.ON$          LAST DATE OF LOGON
  2813. '                                                FORMAT MM/DD/YY
  2814. '                            ACTIVE.BULLETINS  # OF BULLETING
  2815. '                            BULLETIN.PREFIX$  FILESPEC FOR BULLETINS
  2816. '
  2817. '  OUTPUT PARAMETERS  --     NUM.NEW.BULLETS   NUMBER OF NEW BULLETINS
  2818. '                            NEW.BULLETS$      LIST OF NEW BULLET #'S
  2819. '                            Q                 WHERE LAST BULLETIN STORED
  2820. '                                                 IN B$()
  2821. '                            B$()              BULLETINS #'S THAT ARE NEW
  2822. '                                                 (2,3,4,...)
  2823. '
  2824. '  SUBROUTINE PURPOSE -- CHECKS HOW MANY BULLETINS HAVE SYSTEM DATE
  2825. '                        AT OR LATER THAN DATE CALLER LAST LOGGED ON
  2826. '
  2827.       SUB CHKNEWBUL (LAST.ON$,NUM.NEW.BULLETS,NEW.BULLETS$) STATIC
  2828. 58110 NUM.NEW.BULLETS = 0
  2829.       NEW.BULLETS$ = ":  "
  2830.       BASE.DATE# = VAL(MID$(LAST.ON$,4,2)) + (100 * VAL(MID$(LAST.ON$,1,2))) + _
  2831.                    (10000# * (1900 + VAL(MID$(LAST.ON$,7,2))))
  2832.       CALL FINDIT (BULLETIN.PREFIX$ + ".FCK")
  2833.       IF OK THEN _
  2834.          WHILE NOT EOF(2) : _
  2835.             LINE INPUT #2,Y$ : _
  2836.             GOSUB 58112 : _
  2837.          WEND _
  2838.       ELSE FOR I = 1 TO ACTIVE.BULLETINS : _
  2839.               Y$ = MID$(STR$(I),2) : _
  2840.               GOSUB 58112 : _
  2841.            NEXT
  2842.       Q = NUM.NEW.BULLETS + 1
  2843.       IF NUM.NEW.BULLETS < 1 THEN _
  2844.          NEW.BULLETS$ = ""
  2845.       EXIT SUB
  2846. 58112 X$ = BULLETIN.PREFIX$ + _
  2847.            Y$ + _
  2848.            CHR$(0)
  2849.       CALL RBBSFIND (X$,IX,YY,MM,DD)
  2850.       IF IX = 0 THEN _
  2851.          FDATE# = DD + (100 * MM) + (10000# * (YY + 1980)) : _
  2852.          IF BASE.DATE# <= FDATE# THEN _
  2853.             NUM.NEW.BULLETS = NUM.NEW.BULLETS + 1 : _
  2854.             B$(NUM.NEW.BULLETS + 1) = Y$ : _
  2855.             NEW.BULLETS$ = NEW.BULLETS$ + _
  2856.             " " + _
  2857.             Y$
  2858.       RETURN
  2859.       END SUB
  2860. ' $SUBTITLE: 'SRTSTRNG - subroutine to sort characters in a string'
  2861. ' $PAGE
  2862. '
  2863. '  SUBROUTINE NAME    -- SRTSTRNG
  2864. '
  2865. '  INPUT PARAMETERS   --     PARAMETER           MEANING
  2866. '                            STRNG$           STRING TO SORT
  2867. '
  2868. '  OUTPUT PARAMETERS  --     STRNG$           SORTED STRING
  2869. '
  2870. '  SUBROUTINE PURPOSE -- SORTS CHARACTERS IN PASSED STRING.
  2871. '
  2872.       SUB SRTSTRNG (STRNG$) STATIC
  2873. 58120 S0 = LEN(STRNG$)
  2874.       S1 = S0
  2875.       X$ = "!"
  2876. 58122 S1 = S1\2
  2877.       IF S1 = 0 THEN _
  2878.          EXIT SUB
  2879.       S2 = S0 - S1
  2880.       FOR S3 = 1 TO S2
  2881.          S4 = S3
  2882. 58124    S5 = S4 + S1
  2883.          IF MID$(STRNG$,S4,1) > MID$(STRNG$,S5,1) THEN _
  2884.             LSET X$ = MID$(STRNG$,S4,1) : _
  2885.             MID$(STRNG$,S4,1) = MID$(STRNG$,S5,1) : _
  2886.             MID$(STRNG$,S5,1) = X$ : _
  2887.             S4 = S4 - S1 : _
  2888.             IF S4 > 0 THEN _
  2889.                GOTO 58124
  2890.       NEXT
  2891.       GOTO 58122
  2892.       END SUB
  2893. ' $SUBTITLE: 'INSCOMMA - subroutine to format commands in command prompt'
  2894. ' $PAGE
  2895. '
  2896. '  SUBROUTINE NAME    -- INSCOMMA
  2897. '
  2898. '  INPUT PARAMETERS   --     PARAMETER           MEANING
  2899. '                            STRNG$           STRING TO REPLACE
  2900. '
  2901. '  OUTPUT PARAMETERS  --     STRNG$           REPLACED STRING
  2902. '
  2903. '  SUBROUTINE PURPOSE -- INSERTS COMMANDS BETWEEN EACH LETTER IN STRNG$
  2904. '                        AND ENCLOSES IN POINTED BRACKETS
  2905. '
  2906.       SUB INSCOMMA (STRNG$) STATIC
  2907. 58130 L = LEN(STRNG$)
  2908.       IF L < 1 THEN _
  2909.          EXIT SUB
  2910.       LSET LINEMES$ = " <" + _
  2911.                       LEFT$(STRNG$,1)
  2912.       FOR K = 2 TO L
  2913.          MID$(LINEMES$,2 * K,2) = "," + _
  2914.                                   MID$(STRNG$,K,1)
  2915.       NEXT
  2916.       STRNG$ = LEFT$(LINEMES$,2 * L + 1) + _
  2917.                ">"
  2918.       END SUB
  2919. ' $SUBTITLE: 'LOADNEW - subroutine to get latest uploads'
  2920. ' $PAGE
  2921. '
  2922. '  SUBROUTINE NAME    -- LOADNEW
  2923. '
  2924. '  INPUT PARAMETERS   --     PARAMETER           MEANING
  2925. '                          UPLOAD.DIRECTORY$  LIST OF FILES UPLOADED
  2926. '
  2927. '  OUTPUT PARAMETERS  --     A$               LATEST UPLOADS
  2928. '
  2929. '  SUBROUTINE PURPOSE -- LOADS TABLE OF MOST RECENT NUMBER OF UPLOADS
  2930. '                        BY DATE
  2931. '
  2932.       SUB LOADNEW (ARA(2)) STATIC
  2933. 58140 IF FMS.DIRECTORY$ = "" THEN _
  2934.          EXIT SUB
  2935.       PREV.BASE$ = ""                                   'KG121803
  2936.       IF PREV.LOADNEW$ = FMS.DIRECTORY$ THEN _
  2937.          ARA(1,1) = 0 : _
  2938.          EXIT SUB
  2939.       PREV.LOADNEW$ = FMS.DIRECTORY$
  2940.       CALL OPENFMS (LAST.REC)
  2941.       FIELD 2, 23 AS PRE.DATE$, _
  2942.                 2 AS MM$, _
  2943.                 1 AS FILL1$, _
  2944.                 2 AS DD$, _
  2945.                 1 AS FILL2$, _
  2946.                 2 AS YY$, _
  2947.                 (2 + MAX.DESC.LEN) AS FILL3$, _
  2948.                 3 AS CATEGORY$, _
  2949.                 2 AS FILL4$
  2950.       MAX.RECS = UBOUND(ARA,1)
  2951.       IF MAX.RECS < 1 THEN _
  2952.          MAX.RECS = 1 _
  2953.       ELSE IF MAX.RECS > 23 THEN _
  2954.               MAX.RECS = 23
  2955.       L = 0
  2956.       K = LAST.REC
  2957.       WHILE K > 0 AND L < MAX.RECS
  2958.          GET #2,K
  2959.          IF INSTR("\= ",LEFT$(PRE.DATE$,1)) > 0 THEN _
  2960.             GOTO 58142
  2961.       IF (CAN.DOWNLOAD.FROM.UP OR CATEGORY$ <> DEFAULT.CATEGORY.CODE$) THEN _
  2962.           L = L + 1 : _
  2963.      ARA(L,1) = 372 * (VAL(YY$) - 80) + 31 * VAL(MM$) + VAL(DD$)  'KG010901
  2964.          IF NOT CAN.DOWNLOAD.FROM.UP THEN _
  2965.             X = MIN.SEC.TO.VIEW _
  2966.          ELSE IF CATEGORY$ = "***" THEN _
  2967.                  X = SYSOP.SECURITY.LEVEL _
  2968.               ELSE IF CATEGORY$ = DEFAULT.CATEGORY.CODE$ THEN _
  2969.                       X = MIN.SEC.TO.VIEW _
  2970.                    ELSE X = OPT.SEC(19)
  2971.          ARA(L,2) = X
  2972. 58142    K = K - 1
  2973.       WEND
  2974.       CLOSE 2
  2975.       END SUB
  2976. ' $SUBTITLE: 'CTNEWFILES - subroutine to count how many files new'
  2977. ' $PAGE
  2978. '
  2979. '  SUBROUTINE NAME    -- CTNEWFILES
  2980. '
  2981. '  INPUT PARAMETERS   --     PARAMETER           MEANING
  2982. '                             LAST.ON$          Date of last logon
  2983. '                             UPLDS$            Latest uploads
  2984. '
  2985. '  OUTPUT PARAMETERS  --    NUM.NEW.FILES       How many after last logon
  2986. '                           RPT.PREFIX$         Set to "At least " if
  2987. '                                                 above is a minimum
  2988. '
  2989. '  SUBROUTINE PURPOSE -- CHECKS HOW MANY FILES IN UPLDS$ WERE UPLOADED ON OR
  2990. '                        AFTER DATE OF LAST LOGON THAT THE USER CAN DOWNLOAD
  2991. '
  2992.       SUB CTNEWFILES (LAST.ON$,UPLDS(2),NUM.USER.FILES,RPT.PREFIX$) STATIC
  2993. 58150 BASE.DATE = 372 * (VAL(MID$(LAST.ON$,7,2)) - 80) + _    'KG010901
  2994.                   31 * (VAL(MID$(LAST.ON$,1,2))) + _
  2995.                   VAL(MID$(LAST.ON$,4,2))
  2996.       NUM.NEW.FILES = 1
  2997.       NUM.USER.FILES = 0
  2998.       WHILE (BASE.DATE <= UPLDS(NUM.NEW.FILES,1) AND _
  2999.                 UPLDS(NUM.NEW.FILES,1) > 0 AND _
  3000.                 NUM.NEW.FILES < UBOUND(UPLDS,1))
  3001.          IF USER.SECURITY.LEVEL => UPLDS(NUM.NEW.FILES,2) THEN _
  3002.             NUM.USER.FILES = NUM.USER.FILES + 1
  3003.          NUM.NEW.FILES = NUM.NEW.FILES + 1
  3004.       WEND
  3005.       IF UPLDS(NUM.NEW.FILES,1) < 1 THEN _
  3006.          NUM.NEW.FILES = NUM.NEW.FILES - 1
  3007.       IF BASE.DATE <= UPLDS(NUM.NEW.FILES,1) THEN _
  3008.          RPT.PREFIX$ = "At least " _
  3009.       ELSE RPT.PREFIX$ = ""
  3010.       END SUB
  3011. ' $SUBTITLE: 'CTLINES - subroutine to determine file categories '
  3012. ' $PAGE
  3013. '
  3014. '  SUBROUTINE NAME    -- CTLINES
  3015. '
  3016. '  INPUT PARAMETERS   -- PARAMETER             MEANING
  3017. '                        DIR.CATEGORY.FILE$    NAME OF THE FILE THAT HAS THE
  3018. '                                              NUMBER OF CATEGORIES IN IT.
  3019. '
  3020. '  OUTPUT PARAMETERS  -- MAX.ENTRIES           NUMBER OF FILE CATEGORIES
  3021. '
  3022. '  SUBROUTINE PURPOSE -- SUBROUTINE TO COUNT THE NUMBER OF CATEGORIES THAT A
  3023. '                        FILE CAN BE CLASSIFIED INTO.
  3024. '
  3025.       SUB CTLINES (MAX.ENTRIES) STATIC
  3026. 58160 CALL LINESNFIL (DIR.CATEGORY.FILE$,MAX.ENTRIES)                ' KG101603
  3027.       MAX.ENTRIES = MAX.ENTRIES + 3
  3028.       IF MAX.ENTRIES < 10 THEN _
  3029.          MAX.ENTRIES = 10
  3030.       END SUB
  3031.       SUB LINESNFIL (FILNAME$,LKNT) STATIC                           ' KG101603
  3032.       CALL FINDIT (FILNAME$)                                         ' KG101603
  3033.       LKNT = 0                                                       ' KG101603
  3034.       IF OK THEN _                                                   ' KG101603
  3035.          WHILE NOT EOF(2) : _                                        ' KG101603
  3036.             LKNT = LKNT + 1 : _                                      ' KG101603
  3037.             LINE INPUT #2,A$ : _                                     ' KG101603
  3038.          WEND                                                        ' KG101603
  3039.       CLOSE 2                                                        ' KG101603
  3040.       END SUB                                                        ' KG101603
  3041. ' $SUBTITLE: 'INITFMS - subroutine to initialize file management system'
  3042. ' $PAGE
  3043. '
  3044. '  SUBROUTINE NAME    -- INITFMS
  3045. '
  3046. '  INPUT PARAMETERS   -- PARAMETER             MEANING
  3047. '                        FMS.DIRECTORY$
  3048. '
  3049. '  OUTPUT PARAMETERS  -- CATEGORY.NAME$()  ELEMENTS 1,2, POSSIBLY MORE
  3050. '                        CATEGORY.CODE$()  ELEMENTS 1,2, POSSIBLY MORE
  3051. '                        CATEGORY.DESC$()  ELEMENTS 1,2, POSSIBLY MORE
  3052. '                        CATEGORY.INDEX    COUNT OF # ELEMENTS IN THE FILE
  3053. '                                          MANAGMENT SYSTEM
  3054. '
  3055. '  SUBROUTINE PURPOSE -- SUBROUTINE TO INITIALIZE THE RBBS-PC UPLOAD MANAGEMENT
  3056. '                        SYSTEM
  3057.       SUB INITFMS (CATEGORY.NAME$(1),CATEGORY.CODE$(1), _
  3058.                    CATEGORY.DESC$(1),CATEGORY.INDEX) STATIC
  3059.       BLNK$ = " "
  3060.       CATEGORY.INDEX = 0
  3061.       IF FMS.DIRECTORY$ <> "" THEN _
  3062.          CATEGORY.INDEX = CATEGORY.INDEX + 1 : _
  3063.          CATN$ = CATEGORY.NAME$(CATEGORY.INDEX) : _
  3064.          CALL BRKFNAME (FMS.DIRECTORY$,DRVPATH$,CATN$,EXTENSION$,FALSE) : _
  3065.          CATEGORY.NAME$(CATEGORY.INDEX) = CATN$ : _
  3066.          CATEGORY.CODE$(CATEGORY.INDEX) = "" : _
  3067.          CATEGORY.DESC$(CATEGORY.INDEX) = "All uploads"_
  3068.       ELSE LIMIT.SEARCH.TO.FMS = FALSE : _
  3069.            EXIT SUB
  3070.       IF LIMIT.SEARCH.TO.FMS OR MASTER.DIRECTORY.NAME$ = MAIN.FMS.DIRECTORY$ THEN _
  3071.          CATEGORY.INDEX = CATEGORY.INDEX + 1 : _
  3072.          CATEGORY.NAME$(CATEGORY.INDEX) = "ALL" : _
  3073.          CATEGORY.CODE$(CATEGORY.INDEX) = "" : _
  3074.          CATEGORY.DESC$(CATEGORY.INDEX) = "All files"
  3075.       CALL FINDIT (DIR.CATEGORY.FILE$)
  3076.       IF NOT OK THEN _
  3077.          EXIT SUB
  3078.       WHILE NOT EOF(2)
  3079.          CATEGORY.INDEX = CATEGORY.INDEX + 1
  3080.          INPUT #2, CATEGORY.NAME$(CATEGORY.INDEX), _
  3081.                    CATEGORY.CODE$(CATEGORY.INDEX), _
  3082.                    CATEGORY.DESC$(CATEGORY.INDEX)
  3083.          CATR$ = CATEGORY.CODE$(CATEGORY.INDEX)
  3084.          CALL REMOVE (CATR$,BLNK$)
  3085.          CATEGORY.CODE$(CATEGORY.INDEX) = CATR$
  3086.       WEND
  3087.       CLOSE 2
  3088.       END SUB
  3089. ' $SUBTITLE: 'DISUPDIR - subroutine to display upload direcotry'
  3090. ' $PAGE
  3091. '
  3092. '  SUBROUTINE NAME    -- DISUPDIR
  3093. '
  3094. '  INPUT PARAMETERS   -- PARAMETER             MEANING
  3095. '                     PASSED.CATEGORIES$    FILE "CATEGORIES" TO BE INCLUDED IN
  3096. '                                           THE SEARCH.
  3097. '                        SEARCH.STRING$     STRING TO SEARCH ON WITHIN THE
  3098. '                                           FILE "CATEGORIES" SELECTED
  3099. '                        SEARCH.DATE$       DATE EQUAL TO OR GREATER THAN TO BE
  3100. '                                           SEARCHED FOR WITH THE "CATEGORIES"
  3101. '                                           AND THE STRING TO SEARCH.
  3102. '                        DOWNLOAD.FLAG      SET TO RECORD # OF LINE TO BEGIN
  3103. '                                           VIEWING - 0 IF AT END
  3104. '
  3105. '  OUTPUT PARAMETERS  -- DOWNLOAD.FLAG      WHENEVER DOWNLOAD REQUESTED, SETS
  3106. '                                           TO NEXT RECORD TO VIEW.  OTHERWISE
  3107. '                                           LEAVES AT ZERO''  SUBROUTINE PURPOS -- DISPLAY THE FILES THAT MEET THE CRITERIA SELECTED IN
  3108. '                        RBBS-PC UPLOAD MANAGEMENT SYSTEM ON THE USERS SCREEN.
  3109. '
  3110.       SUB DISUPDIR (PASSED.CATEGORIES$,SEARCH.STRING$, _
  3111.                     SEARCH.DATE$,DOWNLOAD.FLAG,ABORT.INDEX) STATIC
  3112. 58165 CALL ALLCAPS (SEARCH.STRING$)
  3113.       BLNK$ = " "
  3114.       STOP.INTERRUPTS = FALSE
  3115.       CATEGORIES$ = "," + _
  3116.                     PASSED.CATEGORIES$ + _
  3117.                     ","
  3118.       CAN.DOWNLOAD = (USER.SECURITY.LEVEL => OPT.SEC(19))
  3119.       GOSUB 58185
  3120.       IF DOWNLOAD.FLAG > 0 THEN _
  3121.          UPLOAD.INDEX = DOWNLOAD.FLAG : _
  3122.          DOWNLOAD.FLAG = 0 : _
  3123.          GOTO 58180
  3124.       EXTRA.PRMPT$ = CX$(6)+",V)iew"+EMPASIZE.OFF$
  3125.       IF CAN.DOWNLOAD THEN _
  3126.             EXTRA.PRMPT$ = EXTRA.PRMPT$ +CX$(5)+ ",D)ownload"+EMPASIZE.OFF$ 
  3127.       MAX.PRINT = PAGE.LENGTH - 1
  3128.       BELOW.MIN.SEC = (USER.SECURITY.LEVEL < MIN.SEC.TO.VIEW)
  3129.       NON.STOP = NON.STOP OR (PAGE.LENGTH < 1)
  3130.       CHECK.POINT = 0
  3131.       WILD.SEARCH = (INSTR(SEARCH.STRING$,"?") > 0) _
  3132.                      OR (INSTR(SEARCH.STRING$,"*") > 0)
  3133. 58168 UPLOAD.INDEX = UPLOAD.INDEX + UPINC
  3134.       IF UPLOAD.INDEX = CUTOFF.REC THEN _
  3135.          GOTO 58183
  3136.       GET #2,UPLOAD.INDEX
  3137.       CHECK.POINT = CHECK.POINT + 1
  3138.       ON INSTR("\* =",LEFT$(PART.TO.PRINT$,1)) GOTO 58168,58171,58170,58169
  3139.       GOTO 58172
  3140. 58169 A = VAL(MID$(PART.TO.PRINT$,34))
  3141.       IF USER.SECURITY.LEVEL < A THEN _
  3142.          LAST.OK = FALSE : _
  3143.          GOTO 58168
  3144.       MID$(PART.TO.PRINT$,1,13) = MID$(PART.TO.PRINT$,2,12) + " "
  3145.       A = LEN(STR$(A))
  3146.       MID$(PART.TO.PRINT$,34) = MID$(PART.TO.PRINT$,34 + A) + SPACE$(A)
  3147.       GOTO 58172
  3148. 58170 IF EXTENDED.OFF THEN _
  3149.          GOTO 58168 _
  3150.       ELSE IF LAST.OK THEN _
  3151.          GOTO 58175 _
  3152.       ELSE IF SEARCH.STRING$ <> "" AND (NOT WILD.SEARCH) AND FAILED.SEARCH THEN _
  3153.               A$ = PART.TO.PRINT$ : _
  3154.               CALL ALLCAPS (A$) : _
  3155.               HIGHLITE.POS = INSTR(A$,SEARCH.STRING$) : _
  3156.               IF HIGHLITE.POS > 0 THEN _
  3157.                  HIGHLITE.REC = UPLOAD.INDEX : _
  3158.                  UPLOAD.INDEX = LAST.FNAME : _
  3159.              GET 2,UPLOAD.INDEX :_    ' found 2 of these ==>_ so removed one
  3160.                  GOTO 58175 _
  3161.               ELSE GOTO 58168 _
  3162.            ELSE GOTO 58168
  3163. 58171 IF CATEGORY$ = "***" THEN _
  3164.          GOTO 58176 _
  3165.       ELSE KEE$ = "," + CATEGORY$ + "," : _
  3166.            IF INSTR(CATEGORIES$,KEE$) > 0 THEN _
  3167.               GOTO 58176 _
  3168.            ELSE GOTO 58168
  3169. 58172 LAST.OK = FALSE
  3170.       FAILED.SEARCH = FALSE
  3171.       LAST.FNAME = UPLOAD.INDEX
  3172.       IF CATEGORY$ = "***" THEN _
  3173.          IF NOT SYSOP THEN _
  3174.             GOTO 58178
  3175.       IF CATEGORY$ = DEFAULT.CATEGORY.CODE$ THEN _
  3176.          IF BELOW.MIN.SEC THEN _
  3177.             GOTO 58178
  3178. 58173 IF LEN(CATEGORIES$) > 2 THEN _
  3179.          KEE$ = "," + _
  3180.                 CATEGORY$ + _
  3181.                 "," : _
  3182.          CALL REMOVE (KEE$,BLNK$) : _
  3183.          IF INSTR(CATEGORIES$,KEE$) = 0 THEN _
  3184.             GOTO 58178
  3185.       IF SEARCH.STRING$ <> "" THEN _
  3186.          A$ = PART.TO.PRINT$ : _
  3187.          IF WILD.SEARCH THEN _
  3188.             CALL WILDFILE (SEARCH.STRING$,LEFT$(PART.TO.PRINT$,INSTR(PART.TO.PRINT$," ")-1),OK) : _
  3189.             IF OK THEN _
  3190.                GOTO 58175 _
  3191.             ELSE GOTO 58178 _
  3192.          ELSE CALL ALLCAPS (A$) : _
  3193.               HIGHLITE.POS = INSTR(A$,SEARCH.STRING$) : _
  3194.               IF HIGHLITE.POS > 0 THEN _
  3195.                  HIGHLITE.REC = UPLOAD.INDEX _
  3196.               ELSE FAILED.SEARCH = TRUE : _
  3197.                    GOTO 58178
  3198. 58174 IF SEARCH.DATE$ <> "" THEN _
  3199.          KEE$ = MID$(PART.TO.PRINT$,30,2) + _
  3200.                 MID$(PART.TO.PRINT$,24,2) + _
  3201.                 MID$(PART.TO.PRINT$,27,2) : _
  3202.          IF KEE$ < SEARCH.DATE$ THEN _
  3203.             IF DATE.ORDERED.FMS THEN _
  3204.                GOTO 58183 _
  3205.             ELSE GOTO 58168
  3206. '
  3207. ' *
  3208. ' * Allow the FMS to be both fast and interruptable if a local                *
  3209. ' * user or there is nothing in the input buffer by using QTPUT.              *
  3210. ' *
  3211. '
  3212. 58175 LAST.OK = TRUE
  3213. 58176 A = END.DESC
  3214.       IF LEFT$(PART.TO.PRINT$,5) = "     " THEN _
  3215.          GOTO 58178
  3216.       WHILE MID$(PART.TO.PRINT$,A,1) = " "
  3217.          A = A - 1
  3218.       WEND
  3219.       A$ = LEFT$(PART.TO.PRINT$,A)
  3220.       CALL COLORDIR (A$,"Y")
  3221.       IF UPLOAD.INDEX = HIGHLITE.REC THEN _
  3222.          HIGHLITE.REC = -1 : _
  3223.          HIGHLITE.POS = 0 : _
  3224.          CALL CHKCOLOR (A$,SEARCH.STRING$,"")
  3225. 58177 IF LOCAL.USER THEN _
  3226.          CALL QTPUT(A$,1) : _
  3227.          GOTO 58178
  3228.       CALL EOFCOMM (CHAR%)
  3229.       IF CHAR% = -1 THEN _
  3230.          CALL QTPUT(A$,1) _
  3231.       ELSE SUBROUTINE.PARAMETER = 5 : _
  3232.            CALL TPUT : _
  3233.            IF RET THEN _
  3234.               GOTO 58183
  3235. 58178 IF LINES.PRINTED <= MAX.PRINT AND CHECK.POINT < 1000 THEN _
  3236.          GOTO 58168
  3237.       CALL CARRIER
  3238.       IF SUBROUTINE.PARAMETER = -1 THEN _
  3239.          GOTO 58183
  3240.       CALL TIMEREMAIN (TIME.REMAINING!)
  3241.       IF TIME.REMAINING! < 0.1 THEN _
  3242.          SUBROUTINE.PARAMETER = -1 : _
  3243.          GOTO 58183
  3244.       IF NON.STOP THEN _
  3245.          GOTO 58168
  3246.       IF LINES.PRINTED <= MAX.PRINT THEN _
  3247.          CALL QTPUT (EMPHASIZE.OFF$ + "Files checked thru " + MID$(PART.TO.PRINT$,24,8),1)
  3248. 58180 TURBO.KEY = -TURBO.KEY.USER
  3249.       CALL ASKMORE (EXTRA.PRMPT$, TRUE, FALSE,ABORT.INDEX,FALSE)
  3250.       IF SUBROUTINE.PARAMETER = -1 THEN _
  3251.          GOTO 58183
  3252.       IF NO THEN _
  3253.          GOTO 58183
  3254.       CALL ALLCAPS (B$(1))
  3255.       IF B$(1) = "V" THEN _
  3256.          CALL GETARC : _
  3257.          A = UPLOAD.INDEX : _
  3258.          GOSUB 58185 : _
  3259.          UPLOAD.INDEX = A : _
  3260.          GOTO 58180
  3261.       IF B$(1) = "D" THEN _
  3262.          A$ = CX$(2)+"Download what file(s)"+EMPASIZE.OFF$ : _
  3263.          SUBROUTINE.PARAMETER = 1 : _
  3264.          CALL TGET : _
  3265.          IF Q = 0 THEN _
  3266.             GOTO 58180
  3267.       IF LEN(B$(1)) > 2 THEN _
  3268.          IF NOT YES AND CAN.DOWNLOAD THEN _
  3269.             CALL SKIPLINE (1) : _
  3270.             DOWNLOAD.FLAG = UPLOAD.INDEX : _
  3271.             EXIT SUB
  3272.       IF NON.STOP THEN IF UPLOAD.INDEX > 999 THEN _
  3273.          IF (SEARCH.DATE$ = "" OR NOT EXPERT.USER) THEN _
  3274.             A$ = STR$(UPLOAD.INDEX) + _
  3275.                " files left to search.  Really go non-stop? (Y/[N])" : _
  3276.             NO.ADVANCE = TRUE : _
  3277.             TURBO.KEY = -TURBO.KEY.USER : _
  3278.             SUBROUTINE.PARAMETER = 1 : _
  3279.             CALL TGET : _
  3280.             CALL WIPELINE (79) : _
  3281.             IF NOT YES THEN _
  3282.                NON.STOP = FALSE
  3283.       CHECK.POINT = 0
  3284.       GOTO 58168
  3285. 58183 CLOSE 2
  3286.       NON.STOP = (PAGE.LENGTH < 1)
  3287.       STOP.INTERRUPTS = FALSE
  3288.       A$ = ""
  3289.       EXIT SUB
  3290. 58185 CALL OPENFMS (UPLOAD.INDEX)
  3291.       END.DESC = 33 + MAX.DESC.LEN
  3292.       FIELD 2, END.DESC AS PART.TO.PRINT$, _
  3293.                3 AS CATEGORY$, _
  3294.                2 AS FILLER$
  3295.       PREV.FMS$ = ACTIVE.FMS.DIRECTORY$
  3296.       IF UPINC = -1 THEN _
  3297.          CUTOFF.REC = 0 : _
  3298.          UPLOAD.INDEX = UPLOAD.INDEX + 1 _
  3299.       ELSE CUTOFF.REC = UPLOAD.INDEX + 1 : _
  3300.            UPLOAD.INDEX = 0
  3301.       RETURN
  3302.       END SUB
  3303.